Retro1.org codex

          IDENT  CPUMTR
          ENTRY  CPUMTR
          SST    PPR,FL,TH,T1,T2,T3,RA
          B1=1
          LIST   F
*COMMENT  CPUMTR - CPU MONITOR.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  CPUMTR - CPU MONITOR.
          SPACE  4
***       CPUMTR - CPU MONITOR.
*         G. R. MANSFIELD.   70/12/13.
*         W. E. GOEBEL.      76/01/21.
*         P. T. BARNETT.     80/10/31.
          SPACE  4
***       *CPUMTR* WORKS IN CONJUNCTION WITH *MTR* TO DO
*         THE FOLLOWING TASKS -
*
*         1)  SCHEDULE THE CPU AMONG ELIGIBLE JOBS AT CONTROL POINTS.
*         2)  PERFORM REQUESTED OPERATIONS BY PP-S
*             (MONITOR FUNCTIONS ABOVE *CPUM*).
*         3)  PERFORM REQUESTED OPERATIONS BY JOBS RUNNING AT
*             CONTROL POINTS (RA+1 REQUESTS).
*         4)  PERFORM REQUESTED OPERATIONS BY *MTR*
*             (STORAGE MOVE, ETC.)
*         5)  PERFORM DATA TRANSFERS FOR BUFFERED MASS STORAGE DEVICES
*             (REFER TO THE *CPUCIO* BLOCK FOR AN EXPLANATION OF THE
*             PSEUDO-PP).
*
*         *CPUMTR* CODE RUNS IN BOTH MONITOR AND PROGRAM MODE.  THE
*         CODE USED IN EITHER MODE IS MOSTLY SEPARATE, BUT IN CERTAIN
*         RARE CASES, CODE IS SHARED BETWEEN THE TWO.  IN BOTH CASES,
*         THE CODE EXECUTES AT AN RA OF 0, AND AN FL OF MACHINE FIELD
*         LENGTH, GIVING *CPUMTR* FULL ACCESS TO ALL OF CM (AND ECS).
*
*         MONITOR MODE CODE EXECUTION IS LIMITED TO FUNCTIONS THAT CAN
*         BE DONE QUICKLY OR REQUIRE INTERLOCKING.  PROGRAM MODE
*         CODE IS USED FOR PROCESSING FUNCTIONS THAT POTENTIALLY CAN
*         TAKE A LONG TIME (SUCH AS STORAGE MOVE).  PROGRAM MODE
*         *CPUMTR* RUNS AT CONTROL POINT N+1, AND HAS A CPU PRIORITY
*         OF 100B, HIGHER THAN ANY OTHER JOB IN THE SYSTEM.
          SPACE  4,10
**        IMPLEMENTATION NOTES.
*
*         *CPUMTR* IS LOADED AND RELOCATED BY *CPUMLD*.
*         *CPUMLD* SUPPORTS ONLY THE COMMONLY USED LOADER TABLES,
*         INCLUDING 3400 (PIDL), 3600 (ENTR), 4000 (TEXT),
*         4100 (XFILL), 4200 (FILL), 4600 (XFER), AND 7700 (PRFX)
*         LOADER TABLES.  LOADER TABLES SUCH AS 3700 (XTEXT),
*         4300 (REPL), 4400 (LINK), 4500 (XLINK), AND
*         4700 (XREPL) ARE NOT SUPPORTED BY *CPUMLD*.
*         SINCE *BSSZ* INSTRUCTIONS OF 6 OR MORE WORDS GENERATE
*         *REPL* TABLES, USE OF *CON* OR *BSS* INSTRUCTIONS
*         ARE RECOMMENDED AS AN ALTERNATIVE.
*
*         DUE TO THE DEFINITION OF A *CON* INSTRUCTION IN
*         COMPASS 3.0, DATA INSTRUCTIONS CONTAINING RELOCATABLE
*         ADDRESSES SHOULD USE ONLY THE *VFD* INSTRUCTION.
          SPACE  4
****      ASSEMBLY CONSTANTS.
 
 
 NPPCP    EQU    LREC-1      MAXIMUM NUMBER OF PP-S TO A CP
 RSHF     EQU    12          SHIFT COUNT TO MOVE RA FIELD
                             OF FLSW TO LOWER BITS
 RMSK     EQU    24          FIELD WIDTH OF RA IN CONTROL POINT AREA
 MCUR     EQU    40B         MAXIMUM CONSECUTIVE UNIT RESERVE COUNT
 SDUD     EQU    100         UNABLE TO RELEASE WRITE ACCESS DELAY (MS)
 SDWD     EQU    100         DEVICE WRITE ACCESS REQUESTED DELAY (MS)
 SDMD     EQU    4           *MTE* WAIT DELAY FOR WRITE ACCESS (MS)
 
****
          SPACE  4
*CALL     COMCMAC
*CALL     COMSACC
*CALL     COMSCIO
*CALL     COMSDFS
          QUAL   DSL
*CALL     COMSDSL
          QUAL   *
 DSCP     EQU    /DSL/DSCP   DEADSTART CONTROL POINT
          QUAL   DST
*CALL     COMSDST
          QUAL   *
*CALL     COMSEJT
*CALL     COMSJCE
*CALL     COMSLSD
*CALL     COMSMMF
*CALL     COMSMRT
*CALL     COMSMSP
          QUAL   MTX
*CALL     COMSMTX
          QUAL   *
          QUAL   PFM
*CALL     COMSPFM
          QUAL   *
*CALL     COMSREM
*CALL     COMSPRD
*CALL     COMSSCD
*CALL     COMSSSD
          LIST   X
*CALL     COMSHIO
*CALL     COMSMSC
*CALL     COMSLFD
*CALL     COMSSCP
          LIST   *
*CALL     COMSSRU
          QUAL   DSL
*CALL     COMSDSL
          QUAL   *
          LIST   X
*CALL     COMS176
*CALL     COMSCPS
*CALL     COMSMTR
          LIST   *
          TITLE  MACRO DEFINITIONS.
          NOREF  .1,.2,.3
 BLOCK    SPACE  4,20
**        BLOCK - DEFINE AN OPTIONAL BLOCK OF CPUMTR CODE.
*
*
*         BLOCK  NAME,(TTLE),Q
*         ENTRY  *NAME* = NAME OF BLOCK.
*                *TTLE* = DESCRIPTION TO APPEAR ON TITLE LINE FOLLOWING
*                *CPUMTR - CPU MONITOR *
*                *Q* = QUAL TO BE USED FOR BLOCK IF OTHER THAN *NAME*.
 
 
          PURGMAC BLOCK
 
 BLOCK    MACRO  NAME,TTLE,Q
 _NAME    TTL    CPUMTR - CPU MONITOR _TTLE
          TITLE
          QUAL   Q NAME
          NOREF  .1,.2,.3
          USE    /_NAME/
          USE    /TREL/
          CON    0
          VFD    42/0L_NAME,18/0
          USE    *
          USE    /TJMP/
          CON    0
          VFD    42/0L_NAME,18/0
          USE    *
          ENDM
 BSSZ     SPACE  4,10
**        BSSZ - REDEFINE *BSSZ* PSEUDO INSTRUCTION.
*
*         THE REDEFINED *BSSZ* PSEUDO INSTRUCTION WILL ISSUE AN
*         ASSEMBLY ERROR IF THE RESULTING BINARY CANNOT BE LOADED
*         BY *CPUMLD*.
 
 
 BSSZ.    OPSYN  BSSZ        SAVE OLD DEFINITION
 
          PURGMAC  BSSZ
 
 BSSZ     MACRO  EXP
          BSSZ.  EXP
          ERRPL  EXP-6       *CPUMLD* CANNOT LOAD THIS *CPUMTR*
 BSSZ     ENDM
 CFI      SPACE  4,10
**        CXI XJ,TAB - CONVERT A TABLE ORDINAL TO AN OFFSET.
*
*         CXI    XJ,TAB
*
*         CONVERT THE ORDINAL FOR TABLE *TAB* IN *XJ* INTO AN OFFSET
*         IN *XI*.  *XI* AND *XJ* MUST BE DIFFERENT REGISTERS.  THE
*         VALUE OF *XJ* IS PRESERVED.
 
 
          PURGDEF  CXX,Q
 
 CXX,Q    OPDEF  I,J,TAB
          ERRPL  TAB_E-21B   TABLE ENTRY TOO LONG
          ERRZR  I-J         REGISTERS MUST BE DIFFERENT
 .1       OCTMIC TAB_E
 .A".1"   SKIP
 .A0      ENDIF
          ERR                TABLE ENTRIES ARE DEFINED AS ZERO LENGTH
 .B       SKIP
 .A1      ENDIF
          BX.I   X.J
 .B       SKIP
 .A2      ENDIF
          LX.I   X.J,B1
 .B       SKIP
 .A3      ENDIF
          LX.I   X.J,B1
          IX.I   X.I+X.J
 .B       SKIP
 .A4      ENDIF
          BX.I   X.J
          LX.I   2
 .B       SKIP
 .A5      ENDIF
          BX.I   X.J
          LX.I   2
          IX.I   X.I+X.J
 .B       SKIP
 .A6      ENDIF
          LX.I   X.J,B1
          IX.I   X.I+X.J
          LX.I   1
 .B       SKIP
 .A7      ENDIF
          BX.I   X.J
          LX.I   3
          IX.I   X.I-X.J
 .B       SKIP
 .A10     ENDIF
          BX.I   X.J
          LX.I   3
 .B       SKIP
 .A11     ENDIF
          BX.I   X.J
          LX.I   3
          IX.I   X.I+X.J
 .B       SKIP
 .A12     ENDIF
          BX.I   X.J
          LX.I   2
          IX.I   X.I+X.J
          LX.I   1
 .B       SKIP
 .A13     ENDIF
          BX.I   X.J
          LX.I   2
          IX.I   X.I+X.J
          LX.I   1
          IX.I   X.I+X.J
 .B       SKIP
 .A14     ENDIF
          BX.I   X.J
          LX.I   1
          IX.I   X.I+X.J
          LX.I   2
 .B       SKIP
 .A15     ENDIF
          BX.I   X.J
          LX.I   1
          IX.I   X.I+X.J
          LX.I   2
          IX.I   X.I+X.J
 .B       SKIP
 .A16     ENDIF
          BX.I   X.J
          LX.I   3
          IX.I   X.I-X.J
          LX.I   1
 .B       SKIP
 .A17     ENDIF
          BX.I   X.J
          LX.I   4
          IX.I   X.I-X.J
 .B       SKIP
 .A20     ENDIF
          BX.I   X.J
          LX.I   4
 .B       ENDIF
          ENDM
 ENDBLK   SPACE  4,10
**        ENDBLK - END AN OPTIONAL BLOCK OF CPUMTR CODE.
*
 
 
          PURGMAC ENDBLK
 
 ENDBLK   MACRO
          BSS    0
          USE    *
          QUAL
          ENDM
 IDIV     SPACE  4,10
**        IXI XJ/XK - INTEGER DIVISION.
*
*         IXI    XJ/XK
*         DIVIDE XJ BY XK TO XI.
*         DESTROYS XJ, XK, B7.
 
 
          PURGDEF IXX/X
 
 IXX/X   OPDEF  I,J,K
  PX.J X.J
  PX.K X.K
  NX.K X.K
  FX.I X.J/X.K
  UX.I B7,X.I
  LX.I X.I,B7
  ENDM
 MONITOR  SPACE  4,10
**        MONITOR - ISSUE PSEUDO OUTPUT REGISTER *CPUMTR* FUNCTION.
*
*         MONITOR  FC,RAD
*         WHERE  FC = *CPUMTR* FUNCTION CODE.
*                RAD = RETURN ADDRESS, OPTIONAL IF RETURN TO NEXT
*                      LOCATION AFTER MONITOR CALL.
*
*         CALLS  /BUFIO/IMF.
 
 
          PURGMAC  MONITOR
 MONITOR  MACRO  FC,RAD
          LOCAL  MRA
          IFC    NE,$_RAD$B6$,1
          SB6    RAD MRA
          SX1    FC
          EQ     /BUFIO/IMF  ISSUE MONITOR FUNCTION
 MRA      BSS    0
          ENDM
 ICTE     SPACE  4,10
**        ICTE - INTERNAL CIO FUNCTION CODE TABLE ENTRY.
*
*         ICTE   FC,(FLAGS)
*
*         FC     INTERNAL CIO FUNCTION (DEFINED IN *COMSCIO*).
*
*         FLAGS  FUNCTION FLAGS.
*                BKW = BACKWARD OPERATION.
*                CRW = *READCW*/*WRITECW* OPERATION.
*                EOF = EOF OPERATION - STOP ON EOF FOR READ/SKIP,
*                      FLUSH EOF FOR WRITE OPERATION.
*                EOI = EOI OPERATION - STOP ON EOI FOR READ/SKIP,
*                      FLUSH DATA FROM BUFFER FOR WRITE OPERATION.
*                EOR - EOR OPERATION - STOP OF EOR FOR READ/SKIP,
*                      FLUSH EOR FOR WRITE OPERATION.
*                EXF = FUNCTION LEGAL FOR EXECUTE-ONLY FILE.
*                IOF = REWIND OPERATION (SET IN = OUT = FIRST).
*                LST = *READLS*/*RPHRLS* OPERATION.
*                MSO = MASS STORAGE ONLY FUNCTION.
*                MTO = MAGNETIC TAPE ONLY FUNCTION.
*                NDT = NO DEVICE TYPE RETURNED TO FET.
*                NRW = *READN*/*WRITEN* OPERATION.
*                PRU = PRU OPERATION - STOP ON PRU FOR READ/SKIP,
*                      FLUSH ONLY ONE FULL PRU FOR WRITE.
*                RFE = FUNCTION REQUIRES FNT ENTRY.
*                RWO = REWRITE OPERATION.
*                SKO = SKIP OPERATION.
*                UNL = UNLOAD OPERATION.
*                VFL = VALIDATE FIRST AND LIMIT FET PARAMETERS.
*                VIO = VALIDATE IN AND OUT FET PARAMETERS.
*                XF = EXTENDED FUNCTION LEGAL (3XX/6XX CIO CODE).
 
 
 ICTE     MACRO  FC,FLAGS
          LOCAL  F,FG1,FG2
 FG2      SET    0
 .A       IFC    NE,$_FC$$
 FG1      SET    FC*100B
 .B       ECHO   ,F=(FLAGS)
          IFC    EQ,$_F$BKW$,1
 FG1      SET    FG1+4000B
          IFC    EQ,$_F$CRW$,1
 FG1      SET    FG1+40B
          IFC    EQ,$_F$EOF$,1
 FG1      SET    FG1+EOF
          IFC    EQ,$_F$EOI$,1
 FG1      SET    FG1+EOI
          IFC    EQ,$_F$EOR$,1
 FG1      SET    FG1+EOR
          IFC    EQ,$_F$EXF$,1
 FG2      SET    FG2+100B
          IFC    EQ,$_F$IOF$,1
 FG2      SET    FG2+200B
          IFC    EQ,$_F$LST$,1
 FG1      SET    FG1+20B
          IFC    EQ,$_F$MSO$,1
 FG2      SET    FG2+2000B
          IFC    EQ,$_F$MTO$,1
 FG2      SET    FG2+1000B
          IFC    EQ,$_F$NDT$,1
 FG2      SET    FG2+40B
          IFC    EQ,$_F$NRW$,1
 FG1      SET    FG1+20B
          IFC    EQ,$_F$PRU$,1
 FG1      SET    FG1+PRU
          IFC    EQ,$_F$RFE$,1
 FG2      SET    FG2+400B
          IFC    EQ,$_F$RWO$,1
 FG1      SET    FG1+2000B
          IFC    EQ,$_F$SKO$,1
 FG1      SET    FG1+2000B
          IFC    EQ,$_F$UNL$,1
 FG1      SET    FG1+2000B
          IFC    EQ,$_F$VFL$,1
 FG1      SET    FG1+1
          IFC    EQ,$_F$VIO$,1
 FG1      SET    FG1+2
          IFC    EQ,$_F$XF$,1
 FG2      SET    FG2+4000B
 .B       ENDD
 .A       ELSE
 FG1      SET    7777B
 .A       ENDIF
          VFD    12/FG1,12/FG2,6/0
          ENDM
 JSNMASK  SPACE  4,20
**        JSNMASK - DEFINE CHARACTER MASK FOR ONE CHARACTER OF JSN.
*
*
*         JSNMASK LO,HI,EX
*         ENTRY  *LO* = LOWEST CHARACTER TO APPEAR IN THIS POSITION.
*                *HI* = HIGHEST CHARACTER TO APPEAR IN THIS POSITION.
*                *EX* = CHARACTERS TO BE EXCLUDED FROM THIS POSITION.
 
 
          PURGMAC JSNMASK
 
 JSNMASK  MACRO  LO,HI,EX
          IFC    EQ,$LO$$
 .1       DECMIC 1RA         DEFAULT LOWEST CHARACTER
          ELSE
          ERRNG  1R_LO-1RA   VALUE IS TOO LOW
 .1       DECMIC 1R_LO       LOWEST CHARACTER ALLOWABLE
          ENDIF
          IFC    EQ,$HI$$
 .2       DECMIC 1RZ         DEFAULT HIGHEST CHARACTER
          ELSE
          ERRNG  1R9-1R_HI   VALUE IS TOO HIGH
 .2       DECMIC 1R_HI       HIGHEST CHARACTER ALLOWABLE
          ENDIF
 .2       DECMIC ".2"+1      BIT FOR HIGHEST CHARACTER + 1
 .3       MICRO  1,, -0-1S".2"+1S".1"
          ECHO   4,CH=(EX)   CHARACTERS TO EXCLUDE
          IFGE   1R_CH,".1",3
          IFLT   1R_CH,".2",2
 .4       DECMIC 1R_CH
 .3       MICRO  1,, ".3"+1S".4"
          VFD    60/".3"     EXCLUDED CHARACTER MASK
          ENDM
 PER      SPACE  4,10
**        PER - SET ECS PARITY ERROR PROCESSING PARAMETERS.
*
*
*         PER    X,PROC
*         ENTRY  *X* = EXIT ADDRESS IN CASE OF UNRECOVERABLE ERROR.
*                *PROC* = EXTENDED MEMORY ERROR PROCESSOR.
*                IF PROC IS NOT DEFINED THEN EITHER /ECS/PER OR
*                /PROGRAM/PER IS USED AS THE PROCESSOR DEPENDING ON
*                IF THE CALL IS FROM ECS OR PROGRAM QUAL BLOCK.
 
 
          PURGMAC  PER
 
 PER      MACRO  X,PROC
          LOCAL  A
          QUAL   ECS
 A        EQU    *+1
          QUAL   *
          RJ     PROC PER
 TPER     RMT
          VFD    12/,18/A,12/,18/X
 TPER     RMT
          ENDM
 TVFD     SPACE  4,25
**        TVFD - DEFINE RELOCATABLE -VFD-.
*
*
*         TVFD   N/V,V1,C1,V2,C2,V3,C3,V4,C4,V5,C5,V6
*         ENTRY  *N* = BIT COUNT
*                *V* = BASE VALUE TO WHICH A *VI* WILL BE ADDED.
*                IF *C1* IS NOT PRESENT
*                *V1* = ADDRESS OF VALUE TO BE ADDED DURING PRESET.
*                IF *C1* IS PRESENT THEN
*                *VI* = THE VALUE TO BE ADDED DURING PRESET, IF THE
*                       CORRESPONDING *CI* IS TRUE.
*                *CI* = THE ADDRESS OF THE CONDITION WORD IN PRESET
*                       WHICH TELLS IF THE CORRESPONDING VALUE IS TO BE
*                       BE USED.  IF THE CONDITION WORD IS ZERO, THE
*                       CORRESPONDING VALUE WILL BE USED. THE *CI*S ARE
*                       CHECKED IN ORDER, FROM LEFT TO RIGHT, UNTIL A
*                       TRUE CONDITION IS FOUND.  IF NONE OF THE
*                       CONDITIONS ARE TRUE, *VN* IS USED.
*                *VN* = THE DEFAULT VALUE TO BE SET DURING PRESET.
*                       IT IS THE LAST VALUE SPECIFIED AND MUST NOT
*                       HAVE A CONDITION ASSOCIATED WITH IT.
 
 
          PURGMAC  TVFD
 
 TVFD     MACRO  V,V1,C1,V2,C2,V3,C3,V4,C4,V5,C5,V6
          LOCAL  S
*                            EXTRACT FIELD WIDTH
 .1       MICRO  1,,/V
 .1       MICCNT .1
*                            CHECK FOR RELOCATION REQUIRED
 .2       MICRO  .1+2,, V
 .A       IFC    EQ,$V1$$
          VFD    ".1"/".2"
 .A       ELSE
          VFD    ".1"/S+".2"
 S        SAC    ".1",V1,C1,V2,C2,V3,C3,V4,C4,V5,C5,V6
          IF     -DEF,S,1
          ERRNZ  ".2" 0      V MUST BE ZERO IN A CONDITIONAL *VFD*
 .A       ENDIF
          ENDM
 SAC      SPACE  4,40
**        SAC - SUBSTITUTE ADDRESS CONSTANT.
*
*
*         THERE ARE TWO FORMS OF THE *SAC* MACRO.  IF TWO PARAMETERS
*         ARE SPECIFIED, *SAC* CAUSES A PRESET DETERMINED VALUE TO BE
*         ADDED TO A SPECIFIED FIELD.  IF MORE THAN TWO PARAMETERS ARE
*         SECIFIED, *SAC* CAUSES A SPECIFIED VALUE TO BE SUBSTITUTED
*         INTO THE FIELD ACCORDING TO A PRESET DETERMINED CONDITION.
*
*         SAC    W,V
*
*         ENTRY  *W* = FIELD WIDTH.
*
*                *V* = ADDRESS OF WORD IN PRESET WHOSE VALUE WILL BE
*                      ADDED TO THE SPECIFIED FIELD.
*
*         SAC    W,V1,C1,V2,C2,V3,C3,V4,C4,V5,C5,V6
*
*         ENTRY  *W*  = FIELD WIDTH.
*
*                *VI* = THE VALUE TO BE SUBSTITUTED INTO THE SPECIFIED
*                       FIELD DURING PRESET, IF THE CORRESPONDING *CI*
*                       IS TRUE.
*
*                *CI* = THE ADDRESS OF THE CONDITION WORD IN PRESET
*                       WHICH TELLS IF THE CORRESPONDING VALUE IS TO BE
*                       BE USED.  IF THE CONDITION WORD IS NON-ZERO
*                       (THE CONDITION IS TRUE), THE CORRESPONDING
*                       VALUE WILL BE USED.  THE *CI*S ARE CHECKED IN
*                       ORDER, FROM LEFT TO RIGHT, UNTIL A TRUE
*                       CONDITION IS FOUND.  IF NONE OF THE CONDITIONS
*                       ARE TRUE, *VN* IS USED.
*
*                *VN* = THE DEFAULT VALUE TO BE SET DURING PRESET.
*                       IT IS THE LAST VALUE SPECIFIED AND MUST NOT
*                       HAVE A CONDITION ASSOCIATED WITH IT.
 
 
          PURGMAC  SAC
 
          MACRO  SAC,S,W,V1,C1,V2,C2,V3,C3,V4,C4,V5,C5,V6
          LOCAL  N
          QUAL   PRESET
 .1       SET    *-*P/60
 .2       SET    W+*P-*P/60*60
          USE    /TREL/
 .A       IFC    EQ,$C1$$
 .3       MICRO  1,1,$V1$
 .B       IFC    NE,$".3"$-$
 +        VFD    6/.2,6/W,18/V1,12/2000B,18/.1
 .B       ELSE
 .3       MICRO  2,,$V1$
 +        VFD    6/.2,6/W,18/".3",12/-2000B,18/.1
 .B       ENDIF
 .A       ELSE
 +        VFD    6/.2,6/W,18/C1,12/2000B+N,18/.1
 .B       IFLE   W,24D
 +        JP     V1          FIRST ALTERNATE
 -        JP     V6 V5 V4 V3 V2 V1
 .1       SET    1
 .D       ECHO   ,V=(V2,V3,V4,V5,V6),C=(C2,C3,C4,C5,)
 .E       IFC    NE,$C$$
 +        JP     V           NEXT ALTERNATE
 -        VFD    30/C
 .1       SET    .1+1
 .E       ELSE
          STOPDUP
          IFC    EQ,$V$$,1
          ERR    NO DEFAULT HAS BEEN SPECIFIED
 .E       ENDIF
 .D       ENDD
 N        EQU    .1
 .B       ELSE
 +        VFD    30/V1       ALTERNATE
 -        VFD    30/V2       DEFAULT
 N        EQU    1
 .B       ENDIF
 .A       ENDIF
 
 .A       IFC    NE,$S$$
 .B       IFC    EQ,$C1$$
          QUAL
 S        EQU    0
          QUAL   *
 .B       ELSE
 SAC      RMT
          QUAL
 S        EQU    V1
          QUAL   *
          RMT
 .B       ENDIF
 .A       ENDIF
          USE    *
          QUAL   *
          ENDM
 OPDEFS   SPACE  4
**        CONDITIONAL ADDRESS SETTING.
*
*         THE CAPABILITY EXISTS TO PRESET THE ADDRESS PORTION OF AN
*         INSTRUCTION TO A VALUE DETERMINED DURING DEADSTART OR TO ONE
*         OF SEVERAL VALUES DEPENDING ON A *CONDITION* WORD IN THE
*         PRESET RELOCATION TABLE.
*         IN ORDER TO SET THE ADDRESS PORTION CONDITIONALLY A MACRO
*         MUST BE WRITTEN WHICH CALLS THE *SAC* MACRO TO SET THE
*         ADDRESS PORTION OF THE INSTRUCTIONS.
*
*         AN EXTENSIVE SET OF OPDEFS IS AVAILABLE FOR UNCONDITIONALLY
*         PRESETTING THE SET INSTRUCTIONS.  THERE ARE MANY FORMS OF THE
*         INSTRUCTIONS DEFINED.  SOME EXAMPLES ARE -
*
*         TA2    MS2W,SCA
*         TX3    B7+FLSW,TAG
*
*         THE RESULTING INSTRUCTIONS AFTER PRESET WOULD BE -
*         SA2    MS2W + CONTENTS OF */PRESET/SCA*
*         SX3    B7+FLSW + CONTENTS OF */PRESET/TAG*
*
*         IN MOST CASES THE FIRST PARAMETER CAN BE A CONSTANT, A
*         REGISTER, THEIR SUM OR DIFFERENCE, OR OMITTED ALTOGETHER.
*         THE SECOND PARAMETER (OR ONLY PARAMETER) IS PASSED TO THE
*         *SAC* MACRO.  REFER TO ITS DOCUMENTATION FOR THE POSSIBLE
*         OPTIONS.
*
*         A SMALLER COLLECTION OF MACROS PERMITS THE CONDITIONAL
*         PRESETTING OF SET INSTRUCTIONS.  ANY OR ALL OF THE PARAMETERS
*         MAY CONTAIN A VALUE, A B-REGISTER, OR THEIR SUM.
*
*         TSX0   (B3+OFFSET,CONDITION,TAG)
*
*         THE RESULTING INSTRUCTION AFTER PRESET WOULD BE -
*         SX0    B3+OFFSET   IF CONDITION PRESENT
*         SX0    TAG         IF CONDITION NOT PRESENT
 
 
 TAQ      OPDEF  I,L
          SA.I   0
          SAC    18,L
          ENDM
 
          PURGDEF TBQ
 
 TBQ      OPDEF  I,L
          SB.I   0
          SAC    18,L
          ENDM
 
 TXQ      OPDEF  I,L
          SX.I   0
          SAC    18,L
          ENDM
 
 TAQ,Q    OPDEF  I,K,L
          SA.I   K
          SAC    18,L
          ENDM
 
 TBQ,Q    OPDEF  I,K,L
          SB.I   K
          SAC    18,L
          ENDM
 
 TXQ,Q    OPDEF  I,K,L
          SX.I   K
          SAC    18,L
          ENDM
 
 TAAQ,Q   OPDEF  I,J,K,L
          SA.I   A.J+K
          SAC    18,L
          ENDM
 
 TBAQ,Q   OPDEF  I,J,K,L
          SB.I   A.J+K
          SAC    18,L
          ENDM
 
 TXAQ,Q   OPDEF  I,J,K,L
          SX.I   A.J+K
          SAC    18,L
          ENDM
 
 TABQ,Q   OPDEF  I,J,K,L
          SA.I   B.J+K
          SAC    18,L
          ENDM
 
 TBBQ,Q   OPDEF  I,J,K,L
          SB.I   B.J+K
          SAC    18,L
          ENDM
 
 TXBQ,Q   OPDEF  I,J,K,L
          SX.I   B.J+K
          SAC    18,L
          ENDM
 
 TAXQ,Q   OPDEF  I,J,K,L
          SA.I   X.J+K
          SAC    18,L
          ENDM
 
 TBXQ,Q   OPDEF  I,J,K,L
          SB.I   X.J+K
          SAC    18,L
          ENDM
 
 TXXQ,Q   OPDEF  I,J,K,L
          SX.I   X.J+K
          SAC    18,L
          ENDM
 
 TAA,Q    OPDEF  I,J,L
          SA.I   A.J+0
          SAC    18,L
          ENDM
 
 TBA,Q    OPDEF  I,J,L
          SB.I   A.J+0
          SAC    18,L
          ENDM
 
 TXA,Q    OPDEF  I,J,L
          SX.I   A.J+0
          SAC    18,L
          ENDM
 
 TAB,Q    OPDEF  I,J,L
          SA.I   B.J+0
          SAC    18,L
          ENDM
 
 TBB,Q    OPDEF  I,J,L
          SB.I   B.J+0
          SAC    18,L
          ENDM
 
 TXB,Q    OPDEF  I,J,L
          SX.I   B.J+0
          SAC    18,L
          ENDM
 
 TAX,Q    OPDEF  I,J,L
          SA.I   X.J+0
          SAC    18,L
          ENDM
 
 TBX,Q    OPDEF  I,J,L
          SB.I   X.J+0
          SAC    18,L
          ENDM
 
 TXX,Q    OPDEF  I,J,L
          SX.I   X.J+0
          SAC    18,L
          ENDM
 
 OPDEFS   SPACE  4,10
**        THE FOLLOWING *ECHO* PSEUDO-OP DEFINES A SET OF MACROS THAT
*         PERMITS THE REGISTERS IN THE LIST TO BE SET WITH CONDITIONAL
*         VALUES.
 
 
          ECHO   ,R=(A1,A2,A3,B3,B4,B6,X0,X1,X2,X3,X4,X5,X6,X7)
 
          PURGMAC  TS_R
 
 TS_R     MACRO  L,M         THE *M* SHOULD BE REMOVED LATER
          LOCAL  T
          S_R    T+B0
          IFC    NE,$M$$,4   THIS IS TRANSITIONAL CODE **
          IFEQ   L,0,1                                 **
 T        SAC    21,M        "TWOPARS" "SEQNO"         **
          ELSE   1                                     **
 T        SAC    21,L
          ENDM
 
          ENDD
 OPDEFS   SPACE  4
**        JUMP MACROS.
*
*         A FULL SET OF MACROS IS AVAILABLE FOR THE JUMP INSTRUCTIONS.
*         THE FORM OF A CONDITIONAL JUMP INSTRUCTION IS AS FOLLOWS.
*
*         TNZ    X4,(/ISD/SUB3,ISD,/LSPMMF/SUB2,MMF,/MONITOR/PPRX)
*
*         THE RESULTING INSTRUCTION AFTER PRESET WOULD BE -
*         NZ     X4,/ISD/SUB3  JUMP TO SUB3 IF ISD PRESENT
*         NZ     X4,/LSPMMF/SUB2  JUMP TO SUB2 IF MMF PRESENT
*         NZ     X4,/MONITOR/PPRX  OTHERWISE JUMP TO PPRX
*
*         ANY OR ALL OF THE PARAMETERS OF A *TJP* INSTRUCTION MAY ALSO
*         CONTAIN A REGISTER OR A REGISTER PLUS OFFSET.  THE PARAMETERS
*         MAY BE ANY ALLOWED ON THE *JP* INSTRUCTION.
*
*         TJP    (/PROGRAM/TAG1,MMF,/MONITOR/HNG1)
*
*         THE RESULTING INSTRUCTION AFTER PRESET WOULD BE -
*         JP     0+/PROGRAM/TAG1  JUMP TO TAG1 IF MMF PRESENT
*         JP     0+/MONITOR/HNG1  JUMP TO HNG1 IF MMF NOT PRESENT
 
 
 TJP      MACRO  L,M         THE *M* SHOULD BE REMOVED LATER
          LOCAL  S
          JP     S
          IFC    NE,$M$$,4   THIS IS TRANSITIONAL CODE **
0         ERR    *TJP* CAN HAVE ONLY ONE PARAMETER     **
          IFEQ   L,0,1                                 **
 S        SAC    24,M                                  **
          ELSE   1                                     **
 S        SAC    24,L
          ENDM
 
 TEQ      MACRO  L
          LOCAL  S
          EQ     S
 S        SAC    18,L
          ENDM
 
 TGE      MACRO  J,K,L
          LOCAL  S
 .1       MICRO  1,, J
 .2       MICRO  1,, K
          GE     ".1",".2",S
 S        SAC    18,L
          ENDM
 
 TGT      MACRO  J,K,L
          LOCAL  S
 .1       MICRO  1,, J
 .2       MICRO  1,, K
          GT     ".1",".2",S
 S        SAC    18,L
          ENDM
 
 TZR      MACRO  J,L
          LOCAL  S
 .1       MICRO  1,, J
          ZR     ".1",S
 S        SAC    18,L
          ENDM
 
 TNZ      MACRO  J,L
          LOCAL  S
 .1       MICRO  1,, J
          NZ     ".1",S
 S        SAC    18,L
          ENDM
 
 TPL      MACRO  J,L
          LOCAL  S
 .1       MICRO  1,, J
          PL     ".1",S
 S        SAC    18,L
          ENDM
 
 TNG      MACRO  J,L
          LOCAL  S
 .1       MICRO  1,, J
          NG     ".1",S
 S        SAC    18,L
          ENDM
 OPDEFS   SPACE  4,10
*         THIS INSTRUCTION IS A CONDITIONAL NO-OP.
*         IF THE CONDITION WORD *C* IS NON-ZERO, AN *EQ* TO
*         THE SPECIFIED ADDRESS (*L*) IS ENTERED INTO THIS
*         LOCATION AT PRESET TIME.  OTHERWISE, A *SB0 46000B*
*         IS ENTERED, MAKING THE INSTRUCTION A NO-OP.
 
 TNO      MACRO  L,C
 .1       SET    *P
 .A       IFEQ   .1,15
          NO
 .A       ENDIF
          VFD    30/0400000000B+L
          SAC    30,0400000000B+L,C,6100046000B
          ENDM
 OPDEFS   SPACE  4,10
*         THIS INSTRUCTION IS A CONDITIONAL NO-OP.
*         IF THE CONDITION WORD *C* IS NONZERO, A *NZ B5*
*         TO THE SPECIFIED ADDRESS (*L*) IS ENTERED INTO THIS
*         LOCATION AT PRESET TIME.  OTHERWISE, A *SB0 46000B*
*         IS ENTERED, MAKING THE INSTRUCTION A NO-OP.
 
 TNZB5    MACRO  L,C
 .1       SET    *P
 .A       IFEQ   .1,15
          NO
 .A       ENDIF
          NZ     B5,L
          SAC    30,0550000000B+L,C,6100046000B
          ENDM
 OPDEFS   SPACE  4,10
*         THESE MACROS PERMIT SETTING THE COUNT IN A SHIFT OR MASK
*         INSTRUCTION. THE FORM OF THESE INSTRUCTIONS IS IDENTICAL TO
*         THE OTHER CONDITIONAL INSTRUCTIONS.
*
*         WHEN USING THE *TAX*, *TLX*, OR *TMX* MACROS IN THE FORM
*
*                TLX1 (M,N,CONDITION)
*
*         MAKE SURE THAT *M* AND *N* ARE POSITIVE. FOR EXAMPLE
*         *TLX0 (-6,0,ESM)* SHOULD BE *TLX0 (60-6,0,ESM)*.
 
 
          ECHO   ,R=(0,1,2,3,4,5,6,7)
 
 TAX_R    MACRO  J,L
          LOCAL  S
          IFC    EQ,*L**,3
          AX_R   S
 S        SAC    6,J
          ELSE   4
          AX_R   J
 S        SAC    6,L
          IF     -DEF,S,1
          ERR    ONLY ONE PARAMETER IS PERMITTED ON A CONDITIONAL SHIFT
          ENDM
 
          ENDD
 
          ECHO   ,R=(0,1,2,3,4,5,6,7)
 
 TLX_R    MACRO  J,L
          LOCAL  S
          IFC    EQ,*L**,3
          LX_R   S
 S        SAC    6,J
          ELSE   4
          LX_R   J
 S        SAC    6,L
          IF     -DEF,S,1
          ERR    ONLY ONE PARAMETER IS PERMITTED ON A CONDITIONAL SHIFT
          ENDM
 
          ENDD
 
 TMX3     MACRO  L
          LOCAL  S
          MX3    S
 S        SAC    6,L
          ENDM
 CME      SPACE  4,10
**        THE FOLLOWING MACROS DEFINE INSTRUCTIONS FOR
*         READING AND WRITING CENTRAL MEMORY.  THESE INSTRUCTIONS
*         SHOULD BE USED WHEN ADDRESSING A USER-S FIELD LENGTH,
*         OR FOR ANY ADDRESSING OUTSIDE LOW CORE.  THESE
*         INSTRUCTIONS ARE MODIFIED AT PRESET TIME TO USE
*         THE STANDARD *SAI  XJ* OPCODE IF RUNNING ON A MAINFRAME
*         WITH UP TO 262K OF CENTRAL MEMORY.  OTHERWISE, IT IS
*         SET TO A NEW OPCODE THAT ALLOWS ADDRESSING OF ADDRESSES
*         LARGER THAN 18 BITS.  NOTE THAT THE SAME CONVENTIONS
*         FOR REGISTER USAGE (I.E. 1,2,3,4,5 FOR READING CM;
*         6,7 FOR WRITING CM) STILL EXIST FOR CODE THAT CAN
*         RUN IN EITHER MODE.
 
 
 ERRMC    MACRO
 .A       IF     -DEF,CME$
          ERR    INVALID OP-CODE
 .A       ENDIF
          ENDM
 
 EXREAD   MACRO  I,J
 .1       MICRO  1,1, J
 .A       IFC    NE,$".1"$X$
          ERR    ILLEGAL SOURCE OPERAND
 .A       ENDIF
 .2       MICRO  2,2, J
          VFD    15/660_I_".2"B
          SAC    15,660_I_".2"B,CME,53_I_".2"0B
          ENDM
 
 EXWRIT   MACRO  I,J
 .1       MICRO  1,1, J
 .A       IFC    NE,$".1"$X$
          ERR    ILLEGAL SOURCE OPERAND
 .A       ENDIF
 .2       MICRO  2,2, J
          VFD    15/670_I_".2"B
          SAC    15,670_I_".2"B,CME,53_I_".2"0B
          ENDM
 
 
 ERX0     MACRO  J
          ERRMC
          EXREAD 0,J
          ENDM
 
 ERX1     MACRO  J
          EXREAD 1,J
          ENDM
 
 ERX2     MACRO  J
          EXREAD 2,J
          ENDM
 
 ERX3     MACRO  J
          EXREAD 3,J
          ENDM
 
 ERX4     MACRO  J
          EXREAD 4,J
          ENDM
 
 ERX5     MACRO  J
          EXREAD 5,J
          ENDM
 
 ERX6     MACRO  J
          ERRMC
          EXREAD 6,J
          ENDM
 
 ERX7     MACRO  J
          ERRMC
          EXREAD 7,J
          ENDM
 
 
 EWX0     MACRO  J
          ERRMC
          EXWRIT 0,J
          ENDM
 
 EWX1     MACRO  J
          ERRMC
          EXWRIT 1,J
          ENDM
 
 EWX2     MACRO  J
          ERRMC
          EXWRIT 2,J
          ENDM
 
 EWX3     MACRO  J
          ERRMC
          EXWRIT 3,J
          ENDM
 
 EWX4     MACRO  J
          ERRMC
          EXWRIT 4,J
          ENDM
 
 EWX5     MACRO  J
          ERRMC
          EXWRIT 5,J
          ENDM
 
 EWX6     MACRO  J
          EXWRIT 6,J
          ENDM
 
 EWX7     MACRO  J
          EXWRIT 7,J
          ENDM
          SPACE  4,10
**        THE FOLLOWING OPDEF GENERATES AN 016 INSTRUCTION TO READ THE
*         FREE RUNNING COUNTER TO THE SPECIFIED X REGISTER ON A 180
*         MACHINE.  ON OTHER MACHINES A *BXI XI-XI* INSRUCTION IS
*         GENERATED TO SET THE X REGISTER TO 0.
 
 
 RCX      OPDEF  P1
          VFD    9/016B,3/P1,3/0
          SAC    15,016_P1_0B,CME,13_P1_P1_P1_B
          ENDM
          SPACE  4,10
**        DEFINE OPCODES.
 
 
*         TRAP INSTRUCTION.
 
 RTX,Q    OPDEF  P1,K
+         VFD    9/017B,3/P1,18/K,30/0
          ENDM
 
 
*         INVALIDATE CACHE.
*
*         P1 = 1/  F,59/  ADDR.
*              F = CENTRAL MEMORY/EXTENDED MEMORY INDICATOR (0 IF CM).
*              ADDR = RAC/RAE (RAC IF *F* = 0).
*         P2 = BLOCK LENGTH.
*         K = EI SUBFUNCTION (703B TO INVALIDATE SELECTED CACHE;
*              40000B TO INVALIDATE ALL CACHE ON THE OTHER CPU).
 
 ICX,X,Q  OPDEF  P1,P2,K
+         VFD    9/017B,3/P1,3/P2,15/K,30/0
          ENDM
 OPDEFS   SPACE  4,10
*         TIC - CONDITIONALLY INVALIDATE CACHE.
*
*         THIS INSTRUCTION IS A CONDITIONAL NO-OP.  IF THE CONDITION
*         WORD *C* IS NONZERO, AN *IC 40000B* INSTRUCTION (WHICH
*         INVALIDATES ALL CACHE ON THE OTHER CPU) IS ENTERED INTO
*         THIS LOCATION AT PRESET TIME.  OTHERWISE, TWO *SB0 46000B*
*         INSTRUCTIONS ARE ENTERED, MAKING THIS WORD A NO-OP.
*
*         NOTE - WHEN UPDATING A SEQUENCE OF WORDS TERMINATING IN AN
*         INTERLOCK WORD, THIS INSTRUCTION IS NORMALLY ISSUED JUST
*         BEFORE THE LAST WRITE.  SINCE THE CACHE INVALIDATE
*         OPERATION TIES UP THE OTHER CPU FOR 5 MICROSECONDS (ON A
*         960), THIS SEQUENCE OF INSTRUCTIONS ALLOWS THE FINAL WRITE
*         TO PROCEED IN PARALLEL WITH THE PURGE.  THIS MINIMIZES
*         CACHE PURGE OVERHEAD WHILE STILL ENSURING DATA INTEGRITY.
 
 
 TIC      MACRO  C
+         VFD    30/0170040000B        *IC 40000B*
          SAC    30,0170040000B,C,6100046000B
          VFD    30/0
          SAC    30,0,C,6100046000B
          ENDM
 EXP      SPACE  4
**        EXP - GENERATE EXCHANGE PACKAGE.
 
 
          PURGMAC  EXP
 
 EXP      MACROE P,A0,B0,RA,A1,B1,FL,A2,B2,EM,A3,B3,RAX,A4,B4,FLX,A5,B5,
,MA,A6,B6,EA,A7,B7,X0,X1,X2,X3,X4,X5,X6,X7
          LOCAL  A
          MACREF EXP
 A        BSS    0
 +        VFD    24/P
          VFD    18/A0
          VFD    18/B0
 +        VFD    24/RA
          VFD    18/A1
          VFD    18/B1
+         TVFD   24/FL
          TVFD   18/A2
          VFD    18/B2
          IFC    EQ,$EM$$
 +        TVFD   12/0,EEMC+60B,CP176,EEMC
          ELSE
          TVFD   12/EM
          ENDIF
          VFD    12/
          TVFD   18/A3
          VFD    18/B3
 +        VFD    3/
          TVFD   21/RAX
          TVFD   18/A4
          VFD    18/B4
 +        TVFD   24/FLX
          TVFD   18/A5
          VFD    18/B5
 +        VFD    6/
          TVFD   18/MA
          TVFD   18/A6
          VFD    18/B6
 +        VFD    6/
          IFC    EQ,$EA$$,2
          TVFD   18/0,EEAD
          ELSE   1
          TVFD   18/EA
          TVFD   18/A7
          VFD    18/B7
+         VFD    60/X0
          VFD    60/X1
          VFD    60/X2
          VFD    60/X3
          VFD    60/X4
          VFD    60/X5
          VFD    60/X6
          VFD    60/X7
          ENDM
 MNR      SPACE  4
***       MNR - GENERATE PPU MONITOR PROGRAM MODE FUNCTION TABLE ENTRY.
*
*
*         MNR    FCN,A
*         ENTRY  *FCN* = FUNCTION CODE NAME.
*                *A* = ENTRY ADDRESS.
 
 
          PURGMAC  MNR
 
 MNR      MACRO  FCN,A
          MACREF MNR
          LOC    FCN
          BSS    0
          ORG    TMNR+FCN
          VFD    42/
          IFC    NE,*A**
          TVFD   18/,A
          ELSE   1
          VFD    18//PROGRAM/.FCN
          USE    *
 .FCN     BSS    0
          ENDM
 PMN      SPACE  4
**        PMN - GENERATE PPU MONITOR FUNCTION TABLE ENTRY.
*
*
*         PMN    FCN,A
*         ENTRY  *FCN* = FUNCTION CODE NAME.
*                *A* = ENTRY ADDRESS.
 
 
          PURGMAC  PMN
 
 PMN      MACRO  FCN,A
          MACREF PMN
          LOC    FCN
          BSS    0
          ORG    TPMN-1+FCN
          VFD    42/
 .1       SET    0
          IRP    A
 .1       SET    .1+1
          IRP
          IFEQ   .1,0,1
          VFD    18//MONITOR/.FCN
          IFEQ   .1,1,1
          VFD    18//MONITOR/A
          IFGT   .1,1,1
          TVFD   18/,A
          USE    *
 .FCN     BSS    0
          ENDM
 PPR      SPACE  4,30
**        PPR - GENERATE PPU REQUEST PROCESSOR TABLE ENTRY.
*
*
*         PPR    FCN,MON,PRG,SCP
*         ENTRY  *FCN* = FUNCTION CODE NUMBER.
*                *MON* = MONITOR MODE PROCESSOR.
*                *PRG* = PROGRAM MODE PROCESSOR.
*                *SCP* = *DCP*, DROP CPU OPERATION NEEDS ACTIVE CPU.
*                *SCP* = *FEX*, FAST EXIT WITHOUT FULL PARAMETER SETUP.
*                   ACTIVE CPU CHECK IS NOT MADE WITH *FEX* OPTION.
*
*                THE *MON* AND *PRG* ADDRESSES MAY BE CONDITIONAL
*                VALUES THAT ARE SET DURING PRESET.  THEY ARE SPECIFIED
*                IDENTICALLY TO THE WAY CONDITIONAL ADDRESSES ARE
*                SPECIFIED IN THE CONDITIONAL JUMP MACROES.
*                FOR EXAMPLE THE FOLLOWING INSTRUCTION SETS THE
*                MONITOR MODE PROCESSOR ADDRESS TO EITHER /MMF/IAU
*                OR /0MMF/IAU DEPENDING ON THE PRESENCE OF MMF.
*
*         PPR    IAUM,(/MMF/IAU,/0MMF/IAU,MMF)
*
*         THE CORRECT ENTRY ADDRESS IS SET DEPENDING IN THIS CASE
*         UPON THE PRESENCE OF THE MMF BLOCK.
*
*         NOTE CPUMTR PROGRAM MODE FUNCTIONS MUST ALWAYS
*         BE PROCESSED IN THE SAME CPU, THAT IS CPU-0
*         IF BOTH CPU-S ARE AVAILABLE.
 
 
          PURGMAC  PPR
 
 PPR      MACRO  FCN,A,B,C
          MACREF PPR
          LOC    FCN
          BSS    0
          IFC    NE,*B**,3
          IFC    NE,*C**,2
          IFC    NE,*C*FEX*,1
          ERR    PROGRAM MODE/CPU SELECTION CONFLICT
          ORG    TPPR+FCN-CPUM
 .2       SET    0
          IFC    EQ,*C*FEX*,1
 .2       SET    4000B
          IFC    EQ,*C*DCP*,1
 .2       SET    2000B
          VFD    12/.2
 .1       SET    0
          IRP    B
 .1       SET    .1+1
          IRP
          IFEQ   .1,0,1
          VFD    18//PROGRAM/HNG
          IFEQ   .1,1,1
          VFD    18//PROGRAM/B
          IFGT   .1,1,1
          TVFD   18/,B
          VFD    12/0
 .1       SET    0
          IRP    A
 .1       SET    .1+1
          IRP
          IFEQ   .1,0,1
          VFD    18//MONITOR/.FCN
          IFEQ   .1,1,1
          VFD    18//MONITOR/A
          IFGT   .1,1,1
          TVFD   18/,A
          USE    *
 .FCN     BSS    0
 PPR      ENDM
 SFMACRO  SPACE  4,25
**        SFMACRO - DEFINE THE MACRO TO BUILD A SUBFUNCTION TABLE.
*
* F       SFMACRO  PIF,OPT,BIAS
*
*         *SFMACRO* DEFINES A MACRO (NAMED BY THE *F* PARAMETER) THAT
*         WILL BUILD SUBFUNCTION TABLE ENTRIES THAT ARE PACKED TWO PER
*         WORD.  IF *PAIRED* IS SPECIFIED, THERE IS AN ENTRY FOR EVERY
*         TWO CONSECUTIVE SUBFUNCTION CODES.  EACH ENTRY CONSISTS OF AN
*         ADDRESS IN THE LOWER 18 BITS OF THE WORD AND AN OPTION CODE
*         PACKED INTO THE UPPER 12 BITS OF THE WORD.  WHEN OPTIONS ARE
*         ALLOWED, THEIR CODES AND VALUES ARE SPECIFIED BY THE *OPT*
*         PARAMETER.  THE SECOND ENTRY IS CORRECTLY POSITIONED IN THE
*         WORD.  THE FIRST ENTRY IS POSITIONED BY LEFT SHIFTING THE
*         WORD BY 30 BITS.
*
*         F = FIRST THREE CHARACTERS OF MONITOR FUNCTION NAME.
*         PIF = PAIRED/INDIVIDUAL FLAG.
*             = *INDIVIDUAL*, IF THERE IS ONE SUBFUNCTION PER ENTRY.
*             = *PAIRED*, IF THERE ARE TWO SUBFUNCTIONS PER ENTRY.
*         OPT = AN OPTIONAL LIST OF OPTIONS TO BE ALLOWED FOR EACH
*               ENTRY.  (O=X,P=Y,Q=Z,...)
*               O,P,Q = 1 OR 2 CHARACTER OPTION CODES.
*               X,Y,Z = THE VALUE TO BE USED WHEN CODE IS SPECIFIED.
*               OPTIONS ARE ADDED TOGETHER WHEN MORE THAN ONE IS USED.
*         BIAS = NUMBER OF THE FIRST SUBFUNCTION (DEFAULT = 0).
 
 
          PURGMAC  SFMACRO
 
          MACRO  SFMACRO,F,PIF,OPT,BIAS
 .A       IFC    EQ,/PIF/INDIVIDUAL/
 .1       MICRO  1,,$*$      DELETE PAIRED-ONLY LINES
 .A       ELSE
          IFC    NE,/PIF/PAIRED/,1
          ERR    PARAMETER MUST BE *INDIVIDUAL* OR *PAIRED*
 .1       MICRO  0,,$$       INCLUDE PAIRED-ONLY LINES
 .A       ENDIF
 .A       IFC    EQ,/OPT//
 .2       MICRO  1,,$*$      DELETE OPTION-ONLY LINES
 .A       ELSE
 .2       MICRO  0,,$$       INCLUDE OPTION-ONLY LINES
 .A       ENDIF
 F        SFMACR0  ".1",".2",OPT,BIAS
          ENDM
 SFMACR0  SPACE  4,15
**        SFMACR0 - THE REAL MACRO THAT DOES THE WORK OF *SFMACRO*.
*
* F       SFMACR0  PIF,OPF,OPT,BIAS
*
*         F = FIRST THREE CHARACTERS OF MONITOR FUNCTION NAME.
*         PIF = PAIRED/INDIVIDUAL FLAG.
*             = *INDIVIDUAL*, IF THERE IS ONE SUBFUNCTION PER ENTRY.
*             = *PAIRED*, IF THERE ARE TWO SUBFUNCTIONS PER ENTRY.
*         OPF = OPTIONS FLAG.
*             = -*-, IF OPTIONS MAY BE SPECIFIED FOR THE SUBFUNCTIONS.
*             = NULL, IF OPTIONS ARE NOT USED.
*         OPT = SAME AS *SFMACRO* PARAMETER.
*         BIAS = SAME AS *SFMACRO* PARAMETER.
 
 
          PURGMAC  SFMACR0
 
          MACRO  SFMACR0,F,PIF,OPF,OPT,BIAS
 .A       IFC    EQ,/PIF/*/
 .1       MICRO  0,,$$       OMIT *SF2* PARAMETER
 .A       ELSE
 .B       IFC    EQ,/PIF//
 .1       MICRO  1,,$SF2,$   INCLUDE *SF2* PARAMETER
 .B       ELSE
          ERR    PAIRED FLAG MUST BE -*- OR OMITTED
 .B       ENDIF
 .A       ENDIF
 
 .A       IFC    EQ,/OPF//
 .1       MICRO  1,,$".1"OP,$  INCLUDE *OP* PARAMETER
          IRP    OPT         DEFINE OPTION CODES
 .4       MICRO  1,,=OPT=    GET MNEMONIC
 .4       MICCNT .4
 .5       MICRO  .4+2,,$OPT$ GET VALUE
 .F_M.".4" EQU    ".5"
          IRP
 .A       ELSE
 .B       IFC    NE,/OPF/*/
          ERR    OPTIONS FLAG MUST BE -*- OR OMITTED
 .B       ENDIF
 .A       ENDIF
 
          PURGMAC  F
 
 F        MACRO  SF1,".1"BLOCK
 .6       SET    SF1
PIF .6    SET    SF1/2
 .7       SET    0_BIAS/2
PIF .7    SET    0_BIAS/4
          ERRNZ  T_F+.6-.6/2-.7-*O  SUBFUNCTION OUT OF ORDER
 .6       MICRO  1,17,$/MONITOR/.F_M_SF1$
PIF       ERRNZ  SF1/2*2-SF1 FIRST SUBFUNCTION MUST BE EVEN
PIF       IFC    NE,/SF2//,3
PIF .7    MICRO  1,17,$/MONITOR/.F_M_SF2$
PIF       ERRNZ  SF1*1+1-SF2   SUBFUNCTIONS MUST BE CONSECUTIVE
PIF       ERRNZ  ".6"-".7"   SUBFUNCTIONS NOT DEFINED ON SAME *SUBFUN*
 
          ORG    T1
          LOC    SF1
          VFD    18/".6"
 .8       SET    2000B
OPF       IRP    OP
OPF .8    SET    .8+.F_M.OP  OP IS AN UNDEFINED OPTION
OPF       IRP
 .C       IFEQ   .6,.6/2*2   IF FIRST ENTRY IN WORD
          ORG    T_F+.6/2-.7
          VFD    12/..SF1_NO,18/".6"
 .D       IFC    NE,$BLOCK$$
          SAC    18,".6",BLOCK,/MONITOR/HNG1
 .D       ENDIF
          VFD    12/.8,18/..SF1_NA
 .8       MICRO  1,, ..SF1
 ..SF1_NO OCTMIC 4000B
 ..SF1_NA MICRO  1,,$/MONITOR/HNG1$
          RMT
 ..SF1_NO EQU    "..SF1_NO"B
 ..SF1_NA EQU    "..SF1_NA"
          RMT
 .C       ELSE
          ORG    T_F+.6/2-.7+1
 ".8"NO   OCTMIC .8
 ".8"NA   MICRO  1,,$".6"$
 .D       IFC    NE,$BLOCK$$
          SAC    18,".6",BLOCK,/MONITOR/HNG1
 .D       ENDIF
 .C       ENDIF
          ENDM
 SFMACRO  ENDM
 SUBFUN   SPACE  4,15
**        SUBFUN - DEFINE SUBFUNCTION PROCESSOR.
*
* SFA     SUBFUN FNC,(SFN)
*         ENTRY  SFA = SUBFUNCTION PROCESSOR ENTRY NAME.
*                FNC = FUNCTION NAME.
*                SFN = ONE OR MORE SUBFUNCTION NAMES.
*
*         THIS MACRO DEFINES A SYMBOL, QUALIFIED BY *MONITOR*, FOR EACH
*         SUBFUNCTION IN THE LIST.  THE SYMBOL NAME IS *.FNCSFN*,
*         TRUNCATED TO 8 CHARACTERS.  IT IS SET TO THE ADDRESS OF THE
*         PROCESSOR.
 
 
          PURGMAC  SUBFUN
 
          MACRO  SUBFUN,SFA,FNC,SFN
 SFA      BSS    0
          QUAL   MONITOR
          IRP    SFN
 .1       MICRO  1,8,$.FNC_SFN$
 ".1"     BSS    0
          IRP
          QUAL   *
          ENDM
 RUE      SPACE  4,10
**        RUE - READ USER ECS.
*
*         RUE    MODE
*
*         ENTRY  *MODE* = *MONITOR* IF CALLED FROM MONITOR MODE,
*                OTHERWISE CALLED FROM PROGRAM MODE.
*                (A0) = CM ADDRESS.
*                (B4) = WORD COUNT TO READ FROM USER ECS.
*                (B6) = RETURN ADDRESS.
*                (X0) = 30/ CM ADDRESS, 30/ ECS ADDRESS.
*
*         USES   A - 2, 3, 6, 7, IF */SUE/RUM* ROUTINE CALLED.
*
*         CALLS  /SUE/RUM, IF SIMULTANEOUS UEM/ESM DEFINED.
 
 
 RUE      MACRO  MODE
          LOCAL  S
+         VFD    12/0400B
          SAC    12,0400B,SUE,0114B
          VFD    18/S
 .A       IFC    EQ,*MODE*MONITOR*
 S        SAC    18,/SUE/RUM1,SUE,000000B
 .A       ELSE
 S        SAC    18,/SUE/RUM,SUE,000000B
 .A       ENDIF
          ENDM
 WUE      SPACE  4,10
**        WUE - WRITE USER ECS.
*
*         WUE    MODE
*
*         ENTRY  *MODE* = *MONITOR* IF CALLED FROM MONITOR MODE,
*                OTHERWISE CALLED FROM PROGRAM MODE.
*                (A0) = CM ADDRESS.
*                (B4) = WORD COUNT TO WRITE TO USER ECS.
*                (B6) = RETURN ADDRESS.
*                (X0) = 30/ CM ADDRESS, 30/ ECS ADDRESS.
*
*         USES   A - 2, 3, 6, 7, IF */SUE/WUM* ROUTINE CALLED.
*
*         CALLS  /SUE/WUM, IF SIMULTANEOUS UEM/ESM DEFINED.
 
 
 WUE      MACRO  MODE
          LOCAL  S
+         VFD    12/0400B
          SAC    12,0400B,SUE,0124B
          VFD    18/S
 .A       IFC    EQ,*MODE*MONITOR*
 S        SAC    18,/SUE/WUM1,SUE,000000B
 .A       ELSE
 S        SAC    18,/SUE/WUM,SUE,000000B
 .A       ENDIF
          ENDM
          SPACE  4,10
*         DEFINE *QUAL* ORDER IN CROSS REFERENCE.
 
          QUAL   MONITOR
          QUAL   PROGRAM
          QUAL   PRESET
          QUAL
          TITLE  TABLES.
 TMNR     SPACE  4,10
**        NOTE - THE FOLLOWING TABLES *TMNR*, *TPMN*, AND *TPPR*
*         MUST BE CONTIGOUS AND THE UPPER FOUR BITS OF THE ENTRIES
*         IN THE FIRST TWO TABLES MUST BE 0 DUE TO CODE IN ROUTINE
*         */MONITOR/PPR*.
 
 
**        TMNR - TABLE OF *MTR* PROGRAM MODE REQUEST PROCESSORS.
*         ENTRY  1 WORD.
*
*         INDEXED BY *MTR* PROGRAM MODE FUNCTION.
*
*T        4/0,38/,18/  ADDR
*
*         ADDR   ADDRESS OF PROCESSOR.
 
 
          QUAL   PROGRAM
          USE    TMNR
 TMNR     BSS    0
          DUP    PMXF,1
          VFD    42/0,18//PROGRAM/HNG
 
          USE    *
          QUAL   *
 TPMN     SPACE  4,10
**        TPMN - PPU MONITOR REQUESTS.
*         ENTRY = 1 WORD.
*
*         INDEXED BY PPU MONITOR FUNCTION.
*
*T        4/0,38/,18/  ADDR
*
*         ADDR   ADDRESS OF PROCESSOR.
 
 
          USE    TPMN
 TPMN     BSS    0
          DUP    MXPF-1,1
          VFD    42/0,18//MONITOR/HNG
 
          USE    *
 TPPR     SPACE  4,10
**        TPPR - PPU REQUEST TABLE.
*         ENTRY = 1 WORD.
*
*         INDEXED BY MONITOR FUNCTION.
*
*T        1/F,1/D,10/,18/  PRG,12/,18/  MTR
*
*         F      *SCP* = *FEX* SPECIFIED.
*         D      *SCP* = *DCP* SPECIFIED.
*         PRG    PROGRAM MODE PROCESSOR ADDRESS.
*         MTR    MONITOR MODE PROCESSOR ADDRESS.
 
 
          USE    TPPR
 .1       SET    CPUM-MXPF+1-PMXF
          IFGT   .1,0,2
          DUP    .1,1
          VFD    42/0,18//MONITOR/HNG
 TPPR     BSS    0
          DUP    MXFM-CPUM,1
          VFD    42/0,18//MONITOR/HNG
 
 TPPRL    BSS    0
          USE    *
 TREL     SPACE  4,10
**        THE FOLLOWING DECLARATIONS ESTABLISH THE *TREL* USE BLOCK
*         FOR THE *SAC* MACRO.  *CPUMLD* LOADS THIS BLOCK (FOLLOWED
*         BY THE *TBLK* BLOCK) AFTER ALL OTHER BLOCKS THAT ARE
*         INCLUDED IN THE LOAD.
 
 
          QUAL   PRESET
          USE    /TREL/
 REL      BSS    0
          USE    *
          QUAL   *
 TJMP     SPACE  4,10
**        ESTABLISH *TJMP* BLOCK
 
 
          QUAL   PRESET
          USE    /TJMP/
 TJMP     BSS    0
          USE    *
          QUAL   *
          TITLE  DATA.
 DATA     SPACE  4
 ORG      BSS    0
 DATA     SPACE  4
**        *CPUMTR* LOW MEMORY LOCATIONS.
 
 
 CL       BSS    0
 
          ORG    CL+CBLP     LOADED BLOCK TABLE POINTER
 
          VFD    42/0,18//MONITOR/LBAT
 
          ORG    CL+CSXP     SYSTEM CP EXCHANGE PACKAGE TABLE ADDRESS
 
          VFD    42/0,18//MONITOR/MNRA
 
          ORG    CL+CXBP     *EXPACS* BLOCK POINTER
 
          VFD    42/0,18//MONITOR/MXP
 
          ORG    CL+CFPP     FAST PP LOADER TABLE POINTERS
 
          VFD    24/0,6//MONITOR/TPPIL,6//MONITOR/TFPLL,6/0,18//MONITOR/
,TFPL
 
          ORG    CL+CMST     MONITOR MODE STATUS BY CPU
 
          VFD    60/0
          VFD    60/0
 
          ORG    CL+CPBT     PROGRAM MODE BASE TIME BY CPU
 
          CON    0
          CON    0
 
          ORG    CL+CACX     ALTERNATE CPU EXCHANGE REQUESTS BY CPU
 
          CON    0
          CON    0
 
          ORG    CL+CMTLL
 
          QUAL   MONITOR
 PX       SPACE  4
**        PX - PROGRAM MODE EXIT REQUEST.
*         (PX) IS SET FOR IN THE FOLLOWING CASES.
*         (PX) = 1 INDICATES THAT PROGRAM MODE MONITOR IS COMPLETE.
*         (PX) = -1 INDICATES A PP IS REQUESTED BY PROGRAM MODE MONITOR.
*         (PX) = -2 INDICATES AN *MTR*-LIKE FUNCTION IS REQUESTED BY
*                PROGRAM MODE MONITOR.  (SEE *PMN*.)
 
 
 PX       CON    0           PROGRAM MODE EXIT REQUEST
 PR       SPACE  4
**        PR - PROGRAM MODE REQUESTS.
*         (PR) CONTAINS A STACK OF REQUESTS FOR PROGRAM MODE
*         EXECUTION.
*
*T, PR    1/,11/  MF,20/  PF,1/  PS,27/
*         MF     *MTR* PROGRAM MODE REQUESTS.
*         PF     PP PROGRAM MODE REQUESTS.
*         PS     PSEUDO-PP REQUEST.
 
 
 PR       CON    0
 SMPR     SPACE  4,10
**        SMPR - STORAGE MOVE PROGRAM REQUEST.
*
*         WORD *SMPR* CONTAINS THE REQUEST FOR THE STORAGE MOVE
*         (PROGRAM MODE) EXCHANGE PACKAGE.  IT WILL CONTAIN EITHER
*         *MSTF*+1 OR *MECF*+1, DEPENDING ON WHETHER THE CURRENT
*         STORAGE MOVE REQUEST IS FOR CM OR ECS/ESM/UEM.  IF NO
*         REQUESTS ARE PENDING OR IN PROGRESS, THIS WORD WILL BE
*         ZERO.  NOTE THAT THIS MECHANISM CANNOT STACK REQUESTS.
 
 
 SMPR     CON    0,0
 SMIN     EQU    SMPR+1      STORAGE MOVE INCREMENT
 DD       SPACE  4,10
**        DD - INPUT REGISTER FOR DAYFILE DUMP PROCESSOR.
 
 
 DD       VFD    18/3L1DD,42/0
 MP       SPACE  4
**        MP - INPUT REGISTER FOR MONITOR AUXILLARY PROCESSOR.
*         USED FOR ASSIGNING THE MONITOR AUXILLARY PROCESSOR TO
*         PROCESS REQUESTS FOR STORAGE INCREASES.
 
 
 MP       VFD    18/0L1MA,3/2,39/0
 MT       SPACE  4,10
**        MT - MONITOR MODE TIME. (180 MACHINES).
 
 
 MT       CON    0,0         MONITOR MODE TIME BY CPU
 SA       SPACE  4,10
**        SA - CPU SLICE TIME ACCUMULATED SINCE CPU SWITCH.
 
 
 SA       CON    0,0         SLICE TIME ACCUMULATED BY CPU
          SPACE  4
**        RC - RA+1 AUTO RECALL REQUEST.
 
 
 RC       VFD    24/0LRCLP,36/0
 AM       SPACE  4,10
**        AM - ACTIVITY MASK FOR PP-S AND TAPE.
 
 
 AM       CON    00370000000000007760B
          SPACE  4,10
**        IP - INCREASE PRIORITY ON I/O COMPLETION.
*
*         IP = 20, GIVES NEXT JOB STARTED EXTRA PRIORITY OVER
*                  EQUAL PRIORITY JOB. THIS IS SET BY
*                  *DPPM* AND *RCLM* FUNCTIONS.
*
*         IP = 0, NO CHANGE IN PRIORITY.
 
 
 IP       CON    0
          SPACE  4
**        WT - *WQ* TERMINATOR.
*
*         THE LAST ENTRY IN *WQ* POINTS TO THIS LOCATION.
 
 
 WT       VFD    12/2000B,48/0
 TPRC     SPACE  4,10
**        PRIORITY CONTROL TABLE.
 
 
 TPRC     BSS    0
          DUP    MPRS+1,1
          CON    0
          SPACE  4,10
**        THE FOLLOWING ARE USED FOR TEMPORARY STORAGE.
 
          QUAL   MONITOR
 RA       BSS    1           ADDRESS OF RA
 RA1      BSS    1           ADDRESS OF RA+1
          ERRNZ  RA1-RA-1
 
 T1       BSS    1
 T2       BSS    1
 T3       BSS    1
          QUAL   *
          SPACE  4
****      THE FOLLOWING ARE CONSTANTS.
 
 
 TH       CON    0.001P48+1  .001
          CON    1000.P      1000
 TTH      CON    0.0001P48+1 .0001
          CON    10000.P     10000
 HTH      CON    0.0000001P48+1
****
          TTL    CPUMTR/MONITOR - MONITOR MODE EXECUTION.
          TITLE  MTR - MAIN PROGRAM.
 MTR      SPACE  4
**        MONITOR MODE EXECUTION REGISTER USAGE.
*
*         INVIOLATE USAGE.
*
*         (A0) = CPU NUMBER (0 OR 1).
*         (A5) = OUTPUT REGISTER ADDRESS FOR ALL ROUTINES THAT MAY HAVE
*                BEEN ENTERED FROM A POOL PP EXCHANGE.
*         (B1) = 1.
*         (B2) = ADDRESS OF CALLER-S EXCHANGE PACKAGE.
*         (B7) = CONTROL POINT ADDRESS.
*
*         NOTE - CMU MAY NOT BE USED IN MONITOR MODE ON A DUAL CPU
*         MACHINE WITH ONLY A SINGLE CMU BECAUSE THE CMU MAY BE IN
*         USE ON THE OTHER CPU, CAUSING MONITOR MODE TO WAIT FOR THE
*         CMU TO BECOME FREE.
*
*         CONVENTIONS.
*
*         (B3) = SUBROUTINE EXIT ADDRESS.
 MTRX     SPACE  4
**        MTRX - MONITOR EXIT.
*         THE FOLLOWING RULES MUST BE FOLLOWED ON EXIT -
*
*         1)     ALL EXITS MUST CHECK FOR A POSSIBLE MODE ERROR THAT
*         WAS IN PROCESS (HAD NOT GENERATED AN EXCHANGE) AT THE TIME
*         OF THE EXCHANGE INTERRUPT. IF THIS IS NOT DONE MODE
*         ERRORS WILL NOT BE PROCESSED CORRECTLY ON MACHINES SUCH
*         AS THE CYBER 73.
*
*         2)     ALL EXITS MUST SET (X0) = 0 AND BRANCH TO */NVE/XJ1*
*         (IF PRESENT) IMMEDIATELY PRIOR TO THE *XJ*.  THIS IS A
*         MICROCODE REQUIREMENT.
*
*         3)     ALL EXITS MUST CHECK FOR A CPU SWITCH REQUEST.
 
 
 MTRC     SA7    A5+         STORE OUTPUT REGISTER FOR PPU REQUEST
 PPR1     EQU    MTRC
          EQ     MTRX        EXIT MONITOR MODE
 
 MTRP     SA1    RA1         ADDRESS OF RA+1
          NO
          EWX7   X1          SET RA+1
 
 MTRX     TNO    /MONITOR/MTRX+1,NTRACE
*PPRX     EQU    MTRX
          JP     /TRACE/TRP  CHECK FOR TRAP CONDITION
          SA2    A0+CSWL     CHECK FOR CPU SWITCH REQUEST
          SA3    B2+         CHECK FOR MODE ERROR
          NG     X2,BNJ1     IF CPU SWITCH REQUEST
          AX3    36+1        CHECK FOR P = 0 OR 1
          SB4    XJ1         *CJS* RETURN ADDRESS
          ZR     X3,MTR2     IF MODE ERROR
 
 XJ1      SX0    B0+
          TNO    /CME/XJ2,CME
 XJ1.1    XJ     B2          EXCHANGE TO PROGRAM
 
          TNO    /IH819/XJ2,IH819  CHECK STEP CONDITION
 
 XJ2      SA1    CPSL
          RC     X3          GET MONITOR MODE START TIME IF 180 MACHINE
          PX6    B0,X3
          SA6    CL+CMST+A0  SET CPU CALL AND BASE TIME
          NZ     X1,MTR3     IF PP EXCHANGE REQUESTED
 MTR      SPACE  4
*         ENTRY FROM CPU PROGRAM.
 
 
 MTR      SA2    B2+B1       SET RA
          SX7    B1
          TA5    20B,SP      SET FAKE RA
          AX2    36          RA
          BX6    X2
          IX7    X2+X7       RA+1
          ERX5   X7          READ RA+1
          SA6    RA          STORE RA
          SB3    A6          ADDRESS OF RA ADDRESS
          SA7    A6+B1       STORE RA+1
          ZR     X2,MNR      IF RA = 0, CHECK MONITOR REQUEST
          NZ     X5,CPR      PROCESS CPU REQUEST IF (RA+1) " 0
          TEQ    (/MONITOR/PPE,CP176,/MONITOR/MTRX)  CHECK MODE ERROR
 
*         PROCESS MODE ERROR.
 
 MTR2     SA1    CPAL+A0
          SB6    B2          SET EXCHANGE PACKAGE ADDRESS
          AX1    24
          SB7    X1
          JP     CJS
 
*         PROCESS PP PRIORITY EXCHANGE.
 
 MTR3     SX6    B0          CLEAR EXCHANGE REQUESTED
          SA6    A1
          TA1    PRXS,SDA    COUNT EXCHANGE REQUESTS
          SA2    TSCL+A0
          SX0    B1
          IX6    X1+X0
          AX2    48+3
          SA6    A1
          SX2    X2-LSCS-200B
          PL     X2,MTR      IF SYSTEM PRIORITY
          EQ     SXS         PLACE CONTROL POINT IN RECALL
 MNR      SPACE  4,10
**        MNR - MONITOR REQUEST PROCESSING.
*
*         THIS ROUTINE DOES THE START-UP AND EXIT PROCESSING FOR THE
*         VARIOUS PROGRAM-MODE EXCHANGE PACKAGES CONTAINED WITHIN
*         *CPUMTR*.
*
*         ENTRY  (X3) = MONITOR MODE START TIME IF 180 MACHINE.
 
 
 MNR      SA1    B2+CWQW     GET EXCHANGE PACKAGE TYPE
          MX2    -3
          LX1    -18
          BX1    -X2*X1      EXCHANGE PACKAGE TYPE
          SA1    MNRA+X1     GET PROCESSOR ADDRESS
          AX1    18          SHIFT TO PROCESSOR ADDRESS
          SB4    X1
          JP     B4          JUMP TO PROCESSOR
 
*         PROCESS EXIT FROM CONTROL POINT N+1.
 
 MNR3     SB7    B2          SET CONTROL POINT ADDRESS
          TNO    /BUFIO/MNR,BUFIO  IF BUFFERED I/O PRESENT
          BX0    X0-X0
 MNR4     SA1    PX          PROGRAM MODE EXIT STATUS
          SA2    PR          PROGRAM MODE REQUESTS
          BX7    X7-X7
          SA7    A1          CLEAR EXIT STATUS
          ZR     X1,MTRX     IF PROGRAM MODE NOT COMPLETE
          SB3    X1+3
          TNG    X1,(/ISD/MNR5,ISD,/MONITOR/MNR5)  IF REQUEST
          ZR     X2,BNJ      IF NO MORE REQUESTS TO PROCESS
          EQ     MTRX        RETURN TO PROGRAM MODE
 
*         PROCESS PP REQUEST FROM CONTROL POINT N+1.
 
 MNR5     SX1    B0+         PRESET RESPONSE
          SB6    MNR6        *CAL* RETURN ADDRESS - NO LIMIT
          SB3    MNR7        *CAL* RETURN ADDRESS - ACTIVITY LIMIT
          EQ     CAL         CHECK ACTIVITY LIMIT
 
 MNR6     SA2    B2+16B      PARAMETER WORD IN (X6)
          SA5    B2+17B      PP CALL IN (X7)
          SB4    -1
          BX7    X2
          BX6    X5
          SA7    APQA
          EQ     APQ         ASSIGN PP
 
 MNR7     BX7    X1
          SA7    A5-B1       RETURN STATUS IN (X6)
          EQ     MTRX        RETURN
 
*         PROCESS STORAGE MOVE EXIT PROCESSING.
 
 MNR8     SA1    SMPR        STORAGE MOVE REQUESTS
          NZ     X1,MTRX     IF NOT YET COMPLETE, RETURN
          EQ     TSM         TERMINATE STORAGE MOVE
 
 
*         THE FOLLOWING TABLE MUST BE MAINTAINED IN THE ORDER OF THE
*         PROGRAM MODE EXCHANGE PACKAGE TYPES DEFINED IN *COMSMTR*.
*
*         ENTRY FORMAT -
*
*         24/ 0,18/ PROCESSOR ADDRESS,18/ EXCHANGE PACKAGE ADDRESS
 
 MNRA     VFD    24/0,18/MNR3      CONTROL POINT N+1
          TVFD   18/0,SCA
 
          VFD    24/0,18/MNR8,18//PROGRAM/SMPXP  STORAGE MOVE XP
 
          VFD    24/0        FIELD LENGTH VERIFICATION XP
          TVFD   18/0,(/CME/MNR,CME,0)
          TVFD   18/0,(/CME/VFLXP,CME,0)
 
          VFD    24/0        PSEUDO-PP EXCHANGE PACKAGE
          TVFD   18/0,(/BUFIO/MNR1,BUFIO,/MONITOR/MNR)
          TVFD   18/0,(/BUFIO/CPP,BUFIO,0)
 
*         ALL FOLLOWING ENTRIES WILL HANG *MNR*.
 
          VFD    24/0,18/MNR,18/IXP  CPU 0 IDLE PACKAGE XP
 
          VFD    24/0,18/MNR         CPU 1 IDLE PACKAGE XP
          TVFD   18/0,(/DCP/IXP1,DCP,0)
 
          VFD    24/0,18/MNR,18/0    ILLEGAL
 
          VFD    24/0,18/MNR,18/0    ILLEGAL
 
          CON    0           END OF TABLE
          TITLE  UTILITY SUBROUTINES.
 APP      SPACE  4
 AAD      SPACE  4
**        AAD - APPLY ADDER INCREMENT TO SRU ACCUMULATOR.
*
*         NEW SRU = AD (UNITS) + OLD SRU.
*
*         ENTRY  (X1) = INCREMENT (INTEGER FORMAT).
*                (B3) = EXIT ADDRESS.
*                (B4) = OVERFLOW FLAG.
*
*         EXIT   EXITS THRU ROUTINE *AIO* TO APPLY FINAL
*                INCREMENT TO SRU ACCUMULATOR.
*
*         USES   X - 1, 2, 3, 6.
*                A - 2, 3, 6.
 
 
 AAD      ZR     X1,AIO2     IF NO INCREMENT
          SX2    10000000/200B
          IX1    X1*X2
          LX1    7
          EQ     AIO1        (X1) = SRU INCREMENT
 ACB      SPACE  4,15
**        ACB - ASSIGN COMMUNICATION BUFFER.
*
*         *ACB* ALLOCATES A BUFFER FOR COMMUNICATION BETWEEN
*         *CPUMTR* AND A PP.  IT IS THE RESPONSIBILITY OF THE
*         PP TO CLEAR THE FIRST WORD OF ITS ASSIGNED BUFFER
*         WHEN COMPLETE. THIS *RETURNS* THE BUFFER TO THE
*         SYSTEM FOR FURTHER USAGE.  *CPUMTR* WILL NOT ASSIGN
*         THE BUFFER TO ANYONE ELSE AS LONG AS THE FIRST WORD
*         OF THE BUFFER IS NON-ZERO.
*
*         ENTRY  (B3) = RETURN ADDRESS.
*                (B3) .LT. 0  IF RETURN TO */PROGRAM/APS1*.
*
*         EXIT   (X1) = ADDRESS OF BUFFER.
*                (X1) = 0  IF NO BUFFER AVAILABLE.
*
*         USES   X - 1, 6.
*                A - 1, 6.
 
 
 ACB      SX6    B0+         INITIALIZE BUFFER INDEX
 ACB1     SX1    X6-MCBLL
          ZR     X1,ACB3     IF END OF BUFFER(S)
          SX1    MCB+X6      ADDRESS OF BUFFER
          SX6    X6+MCBL     INCREMENT TO NEXT BUFFER
+         SA1    X1                       **** PERFORM IN ONE WORD ****
          NZ     X1,ACB1     IF ASSIGNED  **** PERFORM IN ONE WORD ****
          SA6    A1                       **** PERFORM IN ONE WORD ****
          SX1    A1+         ADDRESS OF BUFFER
 ACB2     NG     B3,/PROGRAM/APS1  IF CALLED BY *APS*
          JP     B3          RETURN
 
 ACB3     TA1    CBNS,SDA    COUNT BUFFER NOT AVAILABLE
          SX6    B1
          IX6    X1+X6
          SA6    A1
          SX1    B0          SET BUFFER NOT AVAILABLE
          EQ     ACB2        RETURN
 MCB      SPACE  4,10
**        MCB - MONITOR COMMUNICATION BUFFER(S).
*
*         THESE BUFFERS ARE USED BY *CPUMTR* TO PASS INFORMATION
*         TO A PP REQUESTED BY IT (SUCH AS *1MA* AND *1MC*).
*         THE ASSEMBLY CONSTANTS ARE DEFINED IN *COMSMSC*.
*
*         NMCB = NUMBER OF BUFFER(S).
*         MCBL = LENGTH OF BUFFER.
 
 
 MCB      BSS    0
 .A       DUP    NMCB
          CON    0           FWA OF BUFFER - NOT BUSY
          BSS    MCBL-1
 .A       ENDD
 MCBLL    EQU    *-MCB       TOTAL LENGTH OF BUFFER(S)
 ACS      SPACE  4,25
**        ACS - ADVANCE CPU SERVICE CYCLE.
*
*         ENTRY  (B3) = EXIT ADDRESS.
*                (X1 BITS 0 - 17) = ADDRESS OF FIRST *WQ* ENTRY AT OR
*                                   BELOW PRIORITY (WITHOUT FLAGS) OF
*                                   NEW JOB.
*                (X3) = NEW JOB *CWQW* (DELINKED FROM *WQ*).
*                (A3) = ADDRESS OF NEW JOB *CWQW*.
*                (B4) = NEW JOB CPU PRIORITY (WITH FLAGS).
*
*         EXIT   SERVICE CYCLE UPDATED FOR PRIORITY.
*                CPU SCHEDULING ACSUMULATORS AND FLAGS RESET FOR
*                  NEW JOB AND ALL *WQ* ENTRIES AT THE SAME CPU
*                  PRIORITY.
*                (X7) = *CSAW* FOR NEW SERVICE CYCLE.
*                (B4) = NEW JOB CPU PRIORITY (WITH FLAGS).
*                (B6) = NEW JOB CPU PRIORITY (WITHOUT FLAGS).
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 5, 6.
 
 
 ACS      BSS    0           ENTRY
 
*         ADVANCE SERVICE CYCLE FOR PRIORITY AND UPDATE NEW JOB CPU
*         SCHEDULING PARAMETERS.
 
          SX6    B4
          AX6    3
          SA2    TPRC+X6     GET SERVICE CYCLE FOR PRIORITY
          MX7    6
          SX0    B1
          LX6    3
          LX0    54-0
          SB6    X6          SET PRIORITY WITHOUT FLAGS FOR COMPARISON
          BX6    X7*X2       OLD SERVICE CYCLE
          BX2    -X7*X2
          IX6    X6+X0
          BX7    X7*X6       NEW SERVICE CYCLE
          BX6    X2+X7       MERGE NEW SERVICE CYCLE
          SX2    24B
          SA6    A2+         UPDATE *TPRC* ENTRY
          LX2    45
          BX3    X3+X2       SET SLICE ACTIVE/INCOMPLETE FLAGS
          SX5    A3+
          BX6    X3
          UX0,B4 X3          SET PRIORITY WITH ACTIVE FLAG
 
*         UPDATE CPU SCHEDULING PARAMETERS FOR ALL *WQ* ENTRIES AT
*         PRIORITY OF NEW JOB.
 
 ACS1     SA1    X1          GET NEXT *WQ* ENTRY
          SA6    X5          UPDATE PRIORITY FLAGS
          SA7    X5+B1       SET SERVICE CYCLE AND CLEAR ACSUMULATORS
          ERRNZ  CSAW-CWQW-1
          SX5    A1
          UX0,B5 X1          UNPACK PRIORITY WITH FLAGS
          BX6    X1+X2       SET SLICE ACTIVE FLAGS
          LE     B6,B5,ACS1  IF PRIORITY (NO FLAGS) SAME AS NEW JOB
          JP     B3          RETURN
 AIO      SPACE  4
**        AIO - APPLY IO INCREMENT TO SRU ACCUMULATOR.
*
*         IO = S2*MS + S3*MT + S4*PF + S5*OD
*
*         NEW SRU = IOM*IO + OLD SRU
*
*         ENTRY  (X1) = INCREMENT (INTEGER FORMAT).
*                (X2) = INCREMENT INDEX.
*                (B3) = EXIT ADDRESS.
*                (B4) = OVERFLOW FLAG.
*
*         USES   X - 0, 1, 2, 3, 4, 6.
*                B - 4, 6.
*                A - 2, 3, 4, 6.
 
 
 AIO      ZR     X1,AIO2     IF NO INCREMENT
          SA2    AIOA+1+X2   INCREMENT MULTIPLIER  (S2, S3, S4 OR S5)
          SA3    B7+MP3W     IO MULTIPLIER (IOM)
          MX6    -30
          PX1    X1
          BX3    -X6*X3      ISOLATE IOM
          NX1    X1
          PX3    X3
          RX1    X2*X1       IO = (S2, S3, S4, S5) * (MS, MT, PF, OD)
          NX3    X3
          RX1    X3*X1       IOM * IO
          UX1,B6 X1
          LX1    B6          (X1) = SRU INCREMENT
          NE     B1,B4,AIO1  IF NOT PF ACCUMULATOR
          SB4    B4+1
 
*         UPDATE SRU ACCUMULATOR.
*         (X1) = INCREMENT.
*         (B4) = 0B FOR NO OVERFLOW,
*                1B FOR ADDER OVERFLOW,
*                2B FOR PF OVERFLOW,
*                4B FOR TAPE OVERFLOW,
*               10B FOR MS OVERFLOW,
*               20B FOR MP OVERFLOW,
*               40B FOR AUC OVERFLOW,
*              100B FOR OD OVERFLOW.
 
 AIO1     SA2    B7+SRUW     SRU ACCUMULATOR
          MX0    -42
          BX6    X2
          SA4    B7+MP3W     CHECK FOR SRU ACCUMULATION DISABLED
          NG     X4,AIO2     IF SRU ACCUMULATION DISABLED
          BX4    -X0*X2      ISOLATE ACCUMULATOR
          SA3    B7+STLW     GET SRU LIMIT
          IX4    X4+X1       APPLY INCREMENT
          BX3    -X0*X3      ISOLATE LIMIT VALUE
          IX6    X2+X1
          IX4    X3-X4       COMPARE LIMIT TO NEW VALUE
          SA6    A2
          PL     X4,AIO2     IF LIMIT NOT EXCEEDED
          SB4    B4+20000B   SET SRU LIMIT FLAG
 AIO2     NZ     B4,AIO3     IF OVERFLOW OR LIMIT HAS OCCURRED
          JP     B3
 
 AIO3     SA2    B7+SRUW     SET LIMIT FLAGS
          SX0    B4
          BX3    X2
          LX0    43          POSITION FLAGS
          LX3    59-53
          NG     X3,RB3      IF RESOURCE LIMITS DISABLED
          BX6    X2+X0
          SA6    A2
          JP     B3          EXIT
 
 AIOA     CON    "S5SRM","S4SRM","S3SRM","S2SRM"  S5,S4,S3,S2
 AMP      SPACE  4,10
**        AMP - ADD MAP PROCESSOR OR OPTICAL DISK INCREMENT.
*
*         IF OD, EXITS TO *AIO* TO APPLY IO INCREMENT.
*
*         IF MAP, NEW SRU = M1 * MAP MULTIPLIER * (X1) + OLD SRU
*
*         ENTRY  (X1) = INCREMENT (INTEGER FORMAT)
*                (X2) = 0 IF MAP INCREMENT,
*                       1 IF OD INCREMENT.
*                (B3) = EXIT ADDRESS
*                (B4) = OVERFLOW FLAG
*
*         EXIT   EXITS THRU ROUTINE *AIO* TO APPLY FINAL
*                INCREMENT TO SRU ACCUMULATOR.
*
*         USES   A - 3.
*                B - 4.
*                X - 1, 2, 3, 6.
 
 AMP      ZR     X1,AIO2     IF NO INCREMENT
          NZ     X2,AMP1     IF OD INCREMENT
          SA3    B7+MPAW     GET M1 * MAP MULTIPLIER
          MX6    18
          BX2    X6*X3       ISOLATE MULTIPLIER
          LX2    18
          IX1    X1*X2       M1 * MAP MULTIPLIER * INCREMENT
          ZR     B4,AIO1     IF NO OVERFLOW
          SB4    20B         SET OVERFLOW FLAG TO MAP
          EQ     AIO1        UPDATE SRU ACCUMULATION
 
 AMP1     SX2    -1          SET INDEX TO *S5*
          ZR     B4,AIO      IF NO OVERFLOW
          SB4    100B        SET OVERFLOW FLAG TO OD
          EQ     AIO         UPDATE IO SRU ACCUMULATION
 
 APQ      SPACE  4,10
**        APQ - ASSIGN PP OR IF UNASSIGNABLE ENTER IN REQUEST QUEUE.
*
*         ENTRY  (X6) = PP CALL.
*                (B3) = EXIT ADDRESS.
*                (B4) = INDEX INTO *TFPL* IF LIBRARY SEARCH NOT NEEDED.
*                (B4) = 0 IF LIBRARY SEARCH NEEDED.
*                (B4) .LT. 0 RETURN REQUESTED WHEN PP UNASSIGNABLE.
*                (B7) = CONTROL POINT ADDRESS.
*                       NOTE THAT THE CONTROL POINT NUMBER IS ENTERED
*                       INTO THE PP CALL BY THIS ROUTINE.
*                (A5) = OUTPUT REGISTER OF REQUESTING PP, IF ANY.
*                (APQA) = PARAMETER WORD.
*                (APQC) = MASK FOR *PPAL* SELECTION.
*
*         EXIT   (X1) = 0 IF PP UNASSIGNABLE AND RETURN REQUESTED.
*                (X1) = -0  IF REJECT FOR STORAGE MOVE.
*                (X1) = *IR* ADDRESS IF PP ASSIGNED.
*
*         USES   X - 1, 2, 3, 4, 7.
*                B - 6.
*                A - 1, 2, 6, 7.
*
*         PRESERVES  X0, B7, B4, B3, A5, A0.
*
*         CALLS  APQ, SPL.
 
 
 APQ      SA2    PPAL        CHECK PP AVAILABILITY
          MX3    20
          LX3    -12
          BX2    X3*X2
          SA3    SCRL        CHECK EMERGENCY STEP
          LX3    59-56
          NG     X3,APQ8     IF EMERGENCY STEP SET
 
*         ENTERED HERE FROM *PPQ*.
 
 APQ1     MX7    20          INITIALIZE PP SELECTION MASK
          LX7    -12
          SA7    APQC
 
*         CHECK FOR SPECIAL PRE-PROCESSING REQUIRED.
*                EXIT TO *CSP* IF CYBER 810/830.
*                EXIT TO *APQ9* IF CYBER 170.
 
          TJP    (/MONITOR/CSP,CP830,/0CME/APQ9,NCME,/MONITOR/APQ1.0)
 APQ1.0   BX3    X2
          MX4    5
          SA2    CMCL        CHECK MOVE REQUESTED
          SX7    B7
          LX4    40-59
          LX7    36-7        MERGE CONTROL POINT NUMBER
          BX6    -X4*X6
          AX2    48
          BX6    X6+X7
          LX2    36
          BX2    X2-X7
          ZR     X2,APQ7     IF MOVE REQUESTED
          ZR     X3,APQ8     IF NO PP AVAILABLE
 
*         ENTER HERE FOR SPECIAL *1VP* ASSIGNMENT REQUEST.
 
 APQ1.1   SB6    APQ2        *SPL* RETURN ADDRESS
          LT     B4,B1,SPL   IF LIBRARY SEARCH / NO PP RECALL
          SA2    PLDP
          SA1    TFPL-1+B4   GET PP DIRECTORY ADDRESS
          AX2    36
          SX1    X1+
          MX3    1
          ZR     X2,APQ7     IF LIBRARY LOCKED
          ZR     X1,SPL      IF FAST PP LOADER TABLE NOT BUILT
          MX4    18
          SA1    X1          READ DIRECTORY ENTRY
          LX3    41-59
          BX1    -X4*X1
          IX7    X1+X3
          BX7    -X3*X7
          TNO    /PROBE/SPL,PROBE
 
 APQ2     ZR     X1,APQ8     IF LIBRARY LOCKED
          SA2    APQC        GET SELECTION MASK
          SA1    PPAL        ASSIGN NEXT PP
          BX2    X2*X1
          MX3    1
          LX3    -12
          NX2    B6,X2       SELECT NEXT AVAILABLE PP
          SX2    B6
          SX4    B6-11B-1
          AX3    B6,X3
          BX1    X1-X3       CLEAR PP AVAILABLE
          NG     X4,APQ2.1   IF NOT SECOND BANK
 
*         THE PPS IN THE SECOND BANK ARE ASSIGNED IN REVERSE ORDER.
*         PP = (31B-20B+12B+12B-BIT NUMBER) = (35B-BIT NUMBER)
 
          SX4    35B         REVERSE ORDER OF SECOND BANK
          IX2    X4-X2
 APQ2.1   LX2    PPCES
          MX4    48
          R=     X3,ASCM
          BX1    X4*X1
          TX2    X2,FP       SET PP COMMUNICATION BLOCK ADDRESS
          LX3    48
          BX7    X7+X3
          SA4    APQB-1      PRESET SEARCH OF TABLE
          SA7    X2+B1       SET PP OR (LOAD PARAMETERS)
          MX7    18
 APQ2.2   SA4    A4+B1       GET NEXT TABLE ENTRY
          ZR     X4,APQ5     IF END OF TABLE
          SB6    X4          SAVE LOAD PARAMETER ADDRESS
          BX4    X4-X6
          BX4    X7*X4
          NZ     X4,APQ2.2   IF PP NAME DOES NOT MATCH
          EQ     B4,B6,APQ3  IF *CPUCIO* REQUEST
          TX4    A5-1,-SP
          NZ     X4,APQ5     IF NOT PSEUDO-PP REQUEST
          SA4    A5+2        LOAD MB+1
          EQ     APQ4        TRANSFER DATA
 
 APQ3     SA4    /CPUCIO/MB
 APQ4     BX7    X4          MOVE MB TO MB
          SA7    A7+B1
          SA4    A4+B1
          ERRNZ  /CPUCIO/MB1-/CPUCIO/MB-1
          BX7    X4          MB1 TO MB+1
          SA7    A7+B1
          SA4    A4+B1
          ERRNZ  /CPUCIO/MB2-/CPUCIO/MB1-1
          BX7    X4          MB2 TO MB+2
          SA7    A7+B1
          EQ     APQ6        SKIP PARAMETER WORD CHECK
 
 APQ5     SA4    APQA        MOVE PARAMETER WORD
          BX7    X4
          SA7    A7+B1       MOVE TO MB
 APQ6     SX4    B7
          SX7    B7          SET FUNCTION PROCESSING CP ADDRESS
          LX4    24          SET CP ADDRESS
          BX7    X7+X4
          LX4    24-7        SET CP NUMBER
          BX7    X7+X4
          TX4    X2,-FP
          LX4    PPXES-PPCES
          TA7    X4+ACPP,FPX SET CP ASSIGNMENT
          BX7    X1
          MX4    20
          LX4    -12
          BX1    X4*X1
          CX1    X1
          SA6    X2          STORE PP INPUT REGISTER
          BX7    X7+X1
          SA7    A1+
          SA1    B7+STSW     INCREMENT PP COUNT
          IX7    X1+X3
          SA7    A1
          SX1    A6          RETURN *IR* ADDRESS
          JP     B3          RETURN
 
 APQ7     BX1    -X1+X1
          NG     B4,RB3      IF NO QUEUEING REQUESTED
 APQ8     BX1    X1-X1
          NG     B4,RB3      IF NO QUEUEING REQUESTED
          MX4    6
          SA3    APQA
          SX2    PQ
          BX7    X3
          SA7    AQRA
          EQ     AQR         ASSIGN QUEUE REQUEST
 
 
 APQA     BSS    1           PARAMETER WORD
 
*         TABLE OF PP-S REQUIRING SPECIAL PROCESSING FOR *CPUCIO*.
 
 APQB     VFD    18/3L1MS,24/,18/LA1MS
          VFD    18/3L1MI,24/,18/LA1MI
          VFD    18/3L1ML,24/,18/LA1ML
          VFD    18/3L1OD,24/,18//MONITOR/LA1OD
          CON    0           END OF TABLE
 
 APQC     VFD    12/0,20/-0,28/0  *PPAL* SELECTION MASK
 TFPL     SPACE  4,10
**        TFPL - FAST PP LOADER TABLE.
*
*         THIS TABLE CONTAINS THE ABSOLUTE MEMORY ADDRESS OF THE *PLD*
*         ENTRY FOR THE CORRESPONDING PP PROGRAM.  IT IS UPDATED
*         BY *SLL* OR *REC* WHEN A LIBRARY CHANGE OR RELOAD OCCURS.
 
 
 TFPL     BSS    0
          LOC    1
 
 LA1MS    VFD    17/0,1/1,18/3L1MS,24/0  *1MS* LIBRARY ENTRY ADDRESS
 LA1AJ    VFD    17/0,1/1,18/3L1AJ,24/0  *1AJ* LIBRARY ENTRY ADDRESS
 LA1MI    VFD    17/0,1/1,18/3L1MI,24/0  *1MI* LIBRARY ENTRY ADDRESS
 LA1RO    VFD    17/0,1/1,18/3L1RO,24/0  *1RO* LIBRARY ENTRY ADDRESS
 LA1SJ    VFD    17/0,1/1,18/3L1SJ,24/0  *1SJ* LIBRARY ENTRY ADDRESS
 LA1MA    VFD    17/0,1/1,18/3L1MA,24/0  *1MA* LIBRARY ENTRY ADDRESS
 LACPM    VFD    17/0,1/1,18/3LCPM,24/0  *CPM* LIBRARY ENTRY ADDRESS
 LALDR    VFD    17/0,1/1,18/3LLDR,24/0  *LDR* LIBRARY ENTRY ADDRESS
 LA1ML    VFD    17/0,1/1,18/3L1ML,24/0  *1ML* LIBRARY ENTRY ADDRESS
 LA1OD    VFD    17/0,1/1,18/3L1OD,24/0  *1OD* LIBRARY ENTRY POINTER
 LA1FA    VFD    17/0,1/1,18/3L1FA,24/0  *1FA* LIBRARY ENTRY ADDRESS
 LA1RU    VFD    17/0,1/1,18/3L1RU,24/0  *1RU* LIBRARY ENTRY ADDRESS
 LA1BP    VFD    17/0,1/1,18/3L1BP,24/0  *1BP* LIBRARY ENTRY ADDRESS
 LA3RX    VFD    17/0,1/1,18/3L3RX,24/0  *3RX* LIBRARY ENTRY ADDRESS
 LA1CP    VFD    17/0,1/1,18/3L1CP,24/0  *1CP* LIBRARY ENTRY ADDRESS
 
 TMSD     EQU    *O-1
          LOC    1
 LA6DI    VFD    18/1,18/3L6DI,24/0  *6DI* PLD ENTRY ADDRESS
 LA6DJ    VFD    18/1,18/3L6DJ,24/0  *6DJ* PLD ENTRY ADDRESS
 LA6DP    VFD    18/1,18/3L6DP,24/0  *6DP* PLD ENTRY ADDRESS
 LA6DE    VFD    18/1,18/3L6DE,24/0  *6DE* PLD ENTRY ADDRESS
 LA6DX    VFD    18/1,18/3L6DX,24/0  *6DX* PLD ENTRY ADDRESS
 LA6DC    VFD    18/1,18/3L6DC,24/0  *6DC* PLD ENTRY ADDRESS
 LA6DD    VFD    18/1,18/3L6DD,24/0  *6DD* PLD ENTRY ADDRESS
 LA6MX    BSS    0           END OF DRIVERS
 
          LOC    *O
 
 TFPLL    EQU    *-TFPL      FAST PP LOADER TABLE LENGTH
 TPPI     SPACE  4,10
**        TPPI - TABLE OF PRE-PROCESSOR INDICES.
*
*         THIS TABLE CONTAINS THE PRE-PROCESSOR NAME AND
*         DEFAULT FL/100B CORRESPONDING TO THE INDEX FOR
*         THE *ENEJ* SUBFUNCTION OF THE *EJT* RA+1 CALL.
*         THIS TABLE MUST IMMEDIATELY FOLLOW THE *TFPL*
*         TABLE SO IT CAN BE LOCATED AND REBUILT BY *SLL*
*         AFTER A LIBRARY CHANGE IS MADE.
 
 
 TPPI     BSS    0
          LOC    0
 
          VFD    42/4LLDR=,18/0
          VFD    42/4LSORT,18/0
          VFD    42/4LPACK,18/0
 
          LOC    *O
 
 TPPIL    EQU    *-TPPI
 AQR      SPACE  4,10
**        AQR - ASSIGN QUEUE REQUEST.
*
*         ENTRY  (X0) = ORDERED QUEUE PARAMETER.
*                (X2) = QUEUE INDEX.
*                     = RQ, IMPLIES AN ORDERED QUEUE REQUIRING X0 SET.
*                (X6) = REQUEST.
*                (A5) = OUTPUT REGISTER ADDRESS (PRIORITY PP REQUEST).
*                (B3) = EXIT ADDRESS.
*                (B7) = CONTROL POINT ADDRESS.
*                (AQRA) = PARAMETER WORD.
*
*         EXIT   (A2) = ADDRESS OF QUEUE ENTRY LINKED TO NEW ENTRY.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 6.
*                A - 1, 3, 6, 7.
*
*         PRESERVES  B3, A5, B7, A0.
 
 
 AQR      SA1    B7+STSW     ALLOCATE RECALL SLOT
          ZR     X6,*        IF PP CALL ZERO
          SA2    TAQR+X2     READ PROCESSING PARAMETERS
          MX7    -4
          BX4    -X7*X1      NEXT FREE RECALL SLOT
*
*         CONTINUING AT THIS POINT WILL YIELD CATASTROPHIC
*         RESULTS AND COVER UP THE AUDIT TRAIL, SO STOP.
*
          ZR     X4,*        IF CONFUSED, HANG
          SB6    B7+RCCW-1
          BX7    X7*X1
          SA3    B6+X4       READ NEXT FREE RECALL SLOT
          SA6    A3+RECW-RCCW  STORE REQUEST TO RECALL
          SA4    AQRA        GET PARAMETER WORD
          MX6    1
          BX6    X4+X6
          SA6    A3+REPW-RCCW
          UX2,B6 X2          SET RECALL ADDER
          SX3    X3+B6
          SB6    X2          SET PROCESSOR ADDRESS
          IX7    X7+X3
          AX2    18          GET START OF QUEUE
          SA7    A1
          MX7    -18
          BX1    X1-X1
          JP     B6          JUMP TO PROCESSOR
 
*         PLACE ENTRY AT END OF QUEUE.
*         USED FOR PQ AND CQ.
*
*         LOOP IS REPLICATED FOR PERFORMANCE.
 
 AQR0     MX1    1           SET NO ROLL FLAG
 AQR1     SA2    X2
          BX3    -X7*X2
          ZR     X3,AQR1.1   IF END OF QUEUE
          SA2    X2
          BX3    -X7*X2
          NZ     X3,AQR1     IF NOT END OF QUEUE
 AQR1.1   BX2    X7*X2
          BX7    X7-X7       CLEAR END OF QUEUE
          BX7    X1+X7
          SA7    A3
          SX7    A3          EXTEND END OF QUEUE
          BX7    X7+X2       INSERT LINK
          SX1    A3          RETURN QUEUE ADDRESS
          SA7    A2+
          JP     B3          RETURN
 
*         ASSIGN ENTRY TO ORDERED QUEUE.
 
 AQR2     SA2    X2+         FIND FIRST ENTRY
          MX4    -12
          BX0    X4*X0
 AQR3     BX7    -X4*X2      EXTRACT LINKAGE
          SB6    A2
          ZR     X7,AQR4     IF END OF QUEUE
          SA2    X7          READ NEXT QUEUE ENTRY
          IX3    X2-X0
          NG     X3,AQR3     IF NOT .LT. THIS QUEUE ENTRY
 AQR4     BX7    X7+X0
          SX3    A3          SET RECALL SLOT ADDRESS
          SA2    B6          REPLACE LINK TO NEW RECALL ENTRY
          SA7    A3
          BX2    X4*X2
          BX7    X2+X3
          SA7    A2+
          JP     B3          RETURN
 
*         PLACE ENTRY AT BEGINNING OF QUEUE.
 
 AQR5     SA2    X2          PLACE ENTRY AT HEAD OF QUEUE
          BX2    -X7*X2
          SX7    A5
          LX7    18
          BX7    X7+X2
          SA7    A3
          SX7    A3
          SA7    A2
          JP     B3          RETURN
 
 
 AQRA     BSS    1
 TAQR     SPACE  4,10
**        TAQR - TABLE OF QUEUE PROCESSING PARAMETERS.
*
*         ENTRY  1 WORD
*T, TAQR  12/  2000+RC,12/,18/  QS,18/  QP
*         RC     RECALL COUNT TO INCREMENT *STSW*.
*         QS     START OF QUEUE POINTER.
*         QP     QUEUE PROCESSOR.
 
 
 TAQR     BSS    0
          LOC    0
 
 BQ       VFD    12/2420B,12/0,18/BQRL,18/AQR2  BUFFER MANAGER
 RQ       VFD    12/2020B,12/0,18/RQRL,18/AQR2  *MTR* RECALL
 NRQ      VFD    12/2420B,12/0,18/RQRL,18/AQR2
 CQ       VFD    12/2420B,12/0,18/CQRL,18/AQR1  *CPUCIO* REQUEST QUEUE
 PQ       VFD    12/2020B,12/0,18/PQRL,18/AQR1  PP REQUEST QUEUE
 NPQ      VFD    12/2420B,12/0,18/PQRL,18/AQR0  PP NO ROLL REQUEST
 PRP      VFD    12/2420B,12/0,18/PQRL,18/AQR5  PRIORITY PP REQUEST
          LOC    *O
 BNJ      SPACE  4,25
**        BNJ - BEGIN NEW JOB.
*
*         THIS ROUTINE UPDATES THE CPU TIME FOR THE CURRENTLY ACTIVE
*         JOB (OLD JOB) IN THIS CPU AND STARTS THE HIGHEST PRIORITY JOB
*         (NEW JOB) THAT CAN USE THIS CPU.
*
*         IF ENTERED AT *BNJ*, (B7) IS THE ACTIVE (OLD JOB) CONTROL
*         POINT AND (X7) IS THE CPU STATUS TO SET FOR THE OLD JOB.
*
*         IF ENTERED AT *BNJ1*, THE OLD JOB CPU STATUS IS ASSUMED TO
*         HAVE BEEN SET PRIOR TO ENTRY IF NOT *A* OR *B* STATUS.
*
*         IF THE OLD JOB CPU STATUS IS *A* OR *B* ON ENTRY, THE CPU
*         STATUS WILL BE CHANGED TO *W* AND THE JOB WILL BE INSERTED IN
*         *WQ* ACCORDING TO PRIORITY AND CPU SLICE EXPIRATION CRITERIA.
*
*         EXIT   EXCHANGE PACKAGE AT (B2) RESET FOR PPU USE.
*                RUNNING TIME UPDATED.
*
*         USES   X - ALL.
*                B - 3, 4, 5, 6.
*                A - 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  ACS, CPT, ESC, /DCP/BNJ, MSM, MSR.
 
 
 BNJ      SA1    B7+STSW
          MX0    3           CLEAR OLD STATUS AND SET NEW
          LX7    -3
          BX1    -X0*X1
          BX7    X7+X1
          SA7    A1+
 
*         ENTRY IF CPU STATUS ALREADY SET OR IF *W* STATUS TO BE SET.
 
 BNJ1     SB3    BNJ2        *CPT* RETURN ADDRESS
          SB6    200B        SET CPU SWITCH FLAG
          TJP    (/NVE/CPT1,NVE,/CME/CPT1,CME,/MONITOR/CP76,CP176,/MONIT
,OR/CPT)
 BNJ2     SA2    X1+STSW     GET CONTROL POINT *STSW*
          SX6    B0+
          SX4    1
          SA6    SA+A0       CLEAR CPU SWITCH ACCUMULATED TIME
          LX4    56
          BX7    X4*X2
          SB4    X1+         EXCHANGE PACKAGE ADDRESS IF SUB-CP ACTIVE
          TNZ    X7,(/MONITOR/ESC,SUBCP,/MONITOR/BNJ2) IF SUB-CP ACTIVE
          LX1    24
          SB4    X1          EXCHANGE PACKAGE ADDRESS IF NOT SUB-CP
 
*         UPDATE CPU SLICE ACCUMULATORS AND FLAGS FOR OLD JOB.
*         INCREMENT CPU SLICE ACCUMULATOR BY TIME USED.
*         CLEAR EXTENDED CPU SLICE INCOMPLETE FLAG IF .LT. RECALL CPU
*           SLICE REMAINING IN EXTENDED CPU SLICE.
*         CLEAR CPU SLICE ACTIVE FLAG IF .LT. RECALL CPU SLICE
*           REMAINING IN CPU SLICE.
*         CLEAR RECALL FLAG IF RECALL CPU SLICE LIMIT REACHED.
*         CLEAR RECALL SLICE ACCUMULATOR IF RECALL FLAG CLEARED.
 
 BNJ3     SA3    B4+CWQW     GET *WQ* PARAMETERS
          SA1    B4+STSW     GET EXCHANGE PACKAGE *STSW*
          SA4    A3+B1       GET CPU SLICE ACCUMULATORS
          ERRNZ  CSAW-CWQW-1
          TAX0   (6,CME,11,CP176,0)  SCALE CPU TIME FOR ACCUMULATORS
          MX7    -9
          LX7    27
          BX7    -X7*X3      SERVICE PARAMETERS INDEX
          BX2    X1
          SX6    A0+ACPS+WCPS
          AX2    57
          LX7    -27
          SB3    X2          (B3) .GT. 0 IF *A* OR *B* CPU STATUS
          LX6    -3
          SB5    X2          SET STATUS FOR DRIVER RECALL CHECK
          LE     B3,B0,BNJ4  IF NOT TO SET *W* STATUS
          BX6    X1-X6       SET *W* STATUS
          SB5    WCPS-7      SET *W* STATUS FOR DRIVER RECALL CHECK
          SA6    A1+
 BNJ4     TA2    X7+CSAT,JCB GET CPU SCHEDULING PARAMETERS
          GT     B3,B0,BNJ5  IF *W* STATUS SET (JOB PREEMPTED)
          NZ     X0,BNJ5     IF CPU SLICE INCREMENT NOT NULL
          SX0    1           SET VALUE TO INSURE SLICE EXPIRATION
 BNJ5     SX5    X4          CPU SLICE ACCUMULATOR
          SX7    X2          EXTENDED CPU SLICE LIMIT
          IX5    X5+X0
          IX5    X5-X7       CHECK TIME LEFT IN EXTENDED CPU SLICE
          LX3    59-48       POSITION RECALL FLAG
          NG     X5,BNJ6     IF .GE. RECALL SLICE LEFT IN EXTENDED
          MX7    6
          SX1    7           SET TO CLEAR ALL CPU SCHEDULING FLAGS
          BX7    X7*X4       SET TO CLEAR ALL ACCUMULATORS
          LX7    -18
          LE     B3,B0,BNJ8  IF *W* STATUS NOT SET
          PL     X3,BNJ8     IF RECALL FLAG NOT SET
          LX4    -18
          LX2    -18
          SX6    X4          RECALL CPU SLICE ACCUMULATOR
          SX1    X2          RECALL CPU SLICE LIMIT
          IX6    X6+X0
          IX6    X6-X1
          SX1    7           SET TO CLEAR ALL CPU SCHEDULING FLAGS
          PL     X6,BNJ8     IF NO TIME REMAINING IN RECALL SLICE
          SX1    5           SET TO CLEAR ALL BUT RECALL FLAG
          EQ     BNJ8        UPDATE ACCUMULATORS AND FLAGS
 
 BNJ6     IX4    X4+X0       INCREMENT CPU SLICE ACCUMULATOR
          LX4    -18
          SX1    6           SET TO CLEAR NORMAL SLICE AND RECALL FLAGS
          SX6    X4          RECALL CPU SLICE ACCUMULATOR
          IX7    X4-X6       CLEAR RECALL CPU SLICE ACCUMULATOR
          LE     B3,B0,BNJ8  IF *W* STATUS NOT SET
          LX2    -18
          SX1    X2+         RECALL CPU SLICE LIMIT
          LX2    -18
          PL     X3,BNJ7     IF RECALL CPU SLICE NOT ACTIVE
          IX6    X6+X0
          IX6    X6-X1
          PL     X6,BNJ7     IF NO TIME REMAINING IN RECALL CPU SLICE
          IX7    X4+X0       INCREMENT RECALL CPU SLICE ACCUMULATOR
          SX1    B0          SET TO PRESERVE ALL FLAGS
          EQ     BNJ8        UPDATE ACCUMULATORS AND FLAGS
 
 BNJ7     SX2    X2          CPU SLICE RECALL EXTENSION
          IX2    X2+X5       CHECK TIME LEFT IN UNEXTENDED CPU SLICE
          MX1    1
          BX2    -X2
          BX1    X1*X2       SET TO CLEAR SLICE ACTIVE IF LIMIT
          LX1    2-59
          SX1    X1+2        SET TO CLEAR RECALL FLAG
 
*         WRITE ACCUMULATORS AND UPDATE CPU SCHEDULING FLAGS.
 
 BNJ8     LX7    18          RESTORE *CSAW*
          LX1    58
          SA7    A4          UPDATE CPU SLICE ACCUMULATORS
          BX3    -X1*X3      CLEAR SELECTED SCHEDULING FLAGS
          SX1    B5
          SX6    B1
          AX1    1
          LX6    57-0
          SX1    X1+B1       (X1) = 0 IF *W* OR *X* STATUS
          BX3    X3+X6       SET DRIVER RECALL NOT REQUIRED
          NZ     X1,BNJ9     IF NOT *W* OR *X* STATUS
          NG     X3,BNJ9     IF *W* STATUS WITH RECALL
          BX3    -X6*X3      CLEAR DRIVER RECALL NOT REQUIRED
 
*         INITIALIZE TO RESET *WQ* LINKAGE.
 
 BNJ9     MX6    42
          LX3    48-59       RESTORE *CWQW*
          SX1    B0+
          LE     B3,B0,BNJ14 IF *W* STATUS NOT SET
          SA2    WQRL
          UX0,B4 X3          OLD JOB CPU PRIORITY AND FLAGS
          BX4    X3
          LX4    59-49
          SX7    A3+         OLD JOB *CWQW* ADDRESS
          PL     X4,BNJ11    IF CPU SLICE INACTIVE
 
*         INSERT OLD JOB IN *WQ* AS FIRST AT PRIORITY.
*         LOOP REPLICATED FOR PERFORMANCE.
 
 BNJ10    SA4    X2
          UX0,B5 X4
          GE     B4,B5,BNJ13 IF POSITION FOUND
          SA2    X4
          UX0,B5 X2
          LT     B4,B5,BNJ10 IF POSITION NOT FOUND
          EQ     BNJ12       SET *WQ* LINKAGE
 
*         INSERT OLD JOB IN *WQ* AS LAST AT PRIORITY.
*         LOOP REPLICATED FOR PERFORMANCE.
 
 BNJ11    SA4    X2
          UX0,B5 X4
          GT     B4,B5,BNJ13 IF POSITION FOUND
          SA2    X4
          UX0,B5 X2
          LE     B4,B5,BNJ11 IF POSITION NOT FOUND
 
*         SET LINKAGE FOR JOB INSERTED IN *WQ*.
 
 BNJ12    BX1    X6*X4       CLEAR LINK
          BX7    X1+X7       MERGE NEW LINK
          SX1    A2          SET LINK TO NEXT ENTRY
          SA7    A4
          EQ     BNJ14       UPDATE LINK
 
 BNJ13    BX1    X6*X2       CLEAR LINK
          BX7    X1+X7       MERGE NEW LINK
          SX1    A4          SET LINK TO NEXT ENTRY
          SA7    A2
 
*         UPDATE OLD JOB PRIORITY FLAGS AND *WQ* LINKAGE.
 
 BNJ14    BX3    X6*X3
          BX7    X3+X1       MERGE LINK
          SA7    A3+         UPDATE *CWQW*
 
*         SELECT NEW JOB, UPDATE *WQ* POINTER, AND ADVANCE CPU SERVICE
*         CYCLE IF JOB WITH INACTIVE CPU SLICE SELECTED.
 
 BNJ15    SA1    WQRL        SELECT NEXT JOB
*         EQ     /DCP/BNJ    (DUAL CPU MACHINE)
          SA3    X1          GET *CWQW* ENTRY
          UX0,B4 X3          UNPACK PRIORITY
          ZR     B4,BNJ15    IF NOT VALID *WQ* FIRST ENTRY
          BX7    X6*X3       CLEAR *WQ* LINK
          BX6    -X6*X3      EXTRACT *WQ* LINK
          SA7    A3
          SA6    A1          UPDATE *WQ* POINTER
          BX3    X7
          LX7    59-49
          NG     X7,BNJ16    IF ACTIVE CPU SLICE
          SB3    BNJ16       SET *ACS* RETURN ADDRESS
          BX1    X6
          EQ     ACS         ADVANCE CPU SERVICE CYCLE
 
*         SET ACTIVE CPU STATUS AND CLEAR *MTR* BYPASS FLAG FOR JOB
*         WITH CPU SWITCH REQUEST.  THE SWITCH REQUEST MAY HAVE BEEN
*         FOR A JOB OTHER THAN THE SELECTED NEW JOB.
 
 BNJ16    SA1    A3+STSW-CWQW  GET CPU STATUS
          SA2    CSWL+A0
          LX3    -27
          MX6    -9
          SX7    A0+ACPS+WCPS
          MX5    -3
          BX6    -X6*X3      SERVICE PARAMETERS INDEX
          LX3    9
          LX7    -3
          BX5    -X5*X3      EXCHANGE PACKAGE TYPE
          BX7    X1-X7       SET ACTIVE STATUS
          LX2    -36
          SA7    A1          UPDATE CPU STATUS
          SX2    X2
          ZR     X2,BNJ17    IF NO *WQ* ENTRY WITH *MTR* BYPASS SET
          SA2    X2          GET *WQ* ENTRY WITH BYPASS FLAG
          SX7    B1
          LX7    26-0
          BX7    -X7*X2      CLEAR *MTR* BYPASS FLAG
          SA7    A2
 
*         SET CPU SCHEDULING CMR POINTERS.
 
 BNJ17    SA4    A3+CSAW-CWQW  GET *CSAW* ACCUMULATORS
          SA1    RTCL
          TA2    X6+CSJT,JCB GET CPU SCHEDULING SERVICE PARAMETERS
          SA3    BNJA
          MX6    -36
          MX7    -12
          SX0    X4+         CPU SLICE ACCUMULATOR
          BX1    -X6*X1      REAL TIME MILLISECOND CLOCK
          PX0    X0
          BX6    -X7*X2      CPU SLICE LIMIT
          NO                 (NON - CME MACHINE)
          SAC    15,40003B,CME,46000B
*         FX0    X0*X3       (CME MACHINE)
          LX2    -12
          UX0    X0
          BX2    -X7*X2      RECALL SLICE LIMIT
          IX6    X6-X0       TIME REMAINING IN CPU SLICE
          IX3    X1+X2       MILLISECOND CLOCK AT END OF RECALL SLICE
          IX0    X6-X2
          IX6    X1+X6       MILLISECOND CLOCK AT END OF CPU SLICE
          PX7    B4,X3       MERGE CPU PRIORITY AND RECALL SLICE LIMIT
          PL     X0,BNJ18    IF .GE. RECALL SLICE IN UNEXTENDED SLICE
          BX6    X3          SET TO SWITCH CPU AT END OF RECALL SLICE
 BNJ18    SA6    CSWL+A0     SET CPU SWITCH CONTROL
          SA7    TSCL+A0     SET PRIORITY AND RECALL SLICE LIMIT
 
*         SET CPU PROGRAM CONTROL CMR POINTERS.  NOTE THAT THE OLD
*         EXCHANGE PACKAGE ADDRESS IN *CPAL* IS THE ADDRESS IN THE
*         JOB-S FIELD LENGTH TO WHICH THE SUB-CONTROL POINT EXCHANGE
*         PACKAGE WILL BE COPIED IF A SUB-CONTROL POINT WAS ACTIVE.
*         EXIT IS MADE TO *MTRX* WITHOUT UPDATING *CPAL* AND *ACPL* IF
*         THE OLD AND NEW JOBS ARE THE SAME TO AVOID THE OVERHEAD OF
*         AN EXCHANGE PACKAGE COPY AND BECAUSE THE RA VALUE READ FROM
*         THE NEW EXCHANGE PACKAGE AREA WILL NOT BE CORRECT IF MONITOR
*         MODE WAS ENTERED FROM A PP EXCHANGE.
 
          SA2    CPAL+A0
          SX1    A4-CSAW     NEW JOB EXCHANGE PACKAGE ADDRESS
          LX5    42
          SA3    X1+B1       READ RA
          BX7    X1+X5       SET NEW EXCHANGE PACKAGE ADDRESS AND TYPE
          SX4    X1
          ZR     X5,BNJ19    IF CONTROL POINT EXCHANGE PACKAGE
          TX4    SCA         SET SYSTEM CONTROL POINT ADDRESS
 BNJ19    MX0    -24
          SB7    X4          NEW CONTROL POINT ADDRESS
          MX6    24
          LX4    24
          BX2    -X0*X2      OLD JOB EXCHANGE PACKAGE ADDRESS
          BX6    X6*X3       NEW JOB RA
          IX0    X1-X2
          BX7    X7+X4       MERGE CONTROL POINT ADDRESS
          ZR     X0,MTRX     IF RESTARTING OLD JOB
          SA6    ACPL+A0     SET RA FOR *MTR* RA+1 CHECK
          SA7    CPAL+A0     SET EXCHANGE PACKAGE POINTERS
          SX3    B2+         OLD EXCHANGE ADDRESS
          SB2    X1          NEW EXCHANGE ADDRESS
          IX1    X3-X2       EXCHANGE PACKAGE MOVE DIFFERENTIAL
          TNO    /NVE/SVS,NVE
 
*         COPY EXCHANGE PACKAGE.
*         ENTRY FROM *XJP* AND *ESC*.
*         RETURN FROM */NVE/SVS*.
*         (B2) = NEW PROGRAM MODE EXCHANGE PACKAGE ADDRESS.
*         (X1) = EXCHANGE PACKAGE MOVE DIFFERENTIAL.
*         (X3) = ADDRESS OF EXCHANGE PACKAGE FOR COPY.
 
 BNJ20    ZR     X1,MTR      IF NO EXCHANGE PACKAGE COPY
          TX2    MCMS        SET MACHINE FIELD LENGTH
          SB4    20B         (B4) = LENGTH OF MOVE
          LX2    36+6
          BX0    X3          FWA OF EXCHANGE COPY
          SB6    BNJ21       *MSM* *MSR* RETURN ADDRESS
          TJP    (/CME/MSR,CME,/MONITOR/MSM,CMUMTR,/MONITOR/MSR)
 BNJ21    SX6    B1          RA = 0, B1 = 1
          BX7    X2+X3       FL, B2
          SA6    X3+B1
          SX4    A5          MERGE FLS AND (A5)
          TX6    XPFE
          LX4    18
          SA7    A6+B1
          LX6    48
          TX1    MECS        SET MACHINE FLX
          TLX1   (6,ESM170,0)
          TX2    MECNF
          BX1    X1+X2
          SA6    A7+B1
          TLX1   (36+3,ESM170,36+9)
          TX6    RAEX        SET RAE BASE ADDRESS
          TLX6   (36+3,ESM170,36+9)
          BX7    X1+X4
          SA6    A6+B1       (RAX)=0
          SA7    A6+B1       FLX, A5
          BX6    X6-X6
          SA6    A7+B1       (MA) = 0
          TEQ    (/MONITOR/BNJ30,CP176,/MONITOR/MTR)
 
 
 BNJA     CON    0.064P48+1  MICROSECONDS/64 TO MILLISECONDS CONVERSION
 CAL      SPACE  4,15
**        CAL - CHECK ACTIVITY LIMIT.
*
*         *CAL* ADDS UP THE ACTIVITY ON THE CONTROL POINT
*         (PP-S ACTIVE, TAPE ACTIVITY, AND PP-S IN RECALL),
*         AND CHECKS TO SEE IF THEY EXCEED THE ALLOWED LIMIT.
*         IF THE CONTROL POINT IS THE SYSTEM CONTROL POINT,
*         PP-S ACTIVE ARE NOT INCLUDED IN THE SUM.
*
*         ENTRY  (B3) = RETURN ADDRESS IF ACTIVITY LIMIT.
*                (B6) = RETURN ADDRESS IF NO LIMIT.
*
*         USES   X - 2, 3, 4.
*                B - 5.
*                A - 2.
 
 
 CAL      SA2    B7+STSW     GET CONTROL POINT STATUS
          MX3    -4
          LX2    -4
          BX4    -X3*X2      PP RECALL, TAPE ACTIVITY
          TB5    B7,-SCA
          LX2    4-48
          ZR     B5,CAL1     IF SYSTEM CONTROL POINT
          BX2    -X3*X2
          IX4    X2+X4       INCLUDE PP ACTIVITY COUNT
 CAL1     SX2    X4-NPPCP
          PL     X2,RB3      IF ACTIVITY LIMIT
          JP     B6          RETURN
 CIA      SPACE  4,20
**        CIA - CHECK *IAF* ACCESSIBILITY.
*
*         *CIA* CHECKS IF *IAF* IS ACCESSIBLE BY LOOKING AT THE
*         SUBSYSTEM CONTROL POINT TABLE (SSCT).  THE *IAF* STATUS WORD
*         STSW IS ALSO CHECKED FOR AN ERROR FLAG, BECAUSE IAF MUST BE
*         CONSIDERED INACCESSIBLE IF AN ERROR FLAG IS SET SO THAT *PP*S
*         AT IAF-S CONTROL POINT WILL DROP AND ALLOW *1AJ* TO PROCESS
*         THE ERROR FLAG.
*
*         ENTRY  (B3) = RETURN ADDRESS.
*
*         EXIT   (B4) = 0, IF *IAF* IS ACCESSIBLE AND NO ERROR FLAGS
*                          ARE SET.
*                     .NE. 0, IF *IAF* IS UNACCESSIBLE OR AN ERROR FLAG
*                          IS SET.
*                (X2) = SSCT WORD.
*
*         USES   X - 0, 2, 3.
*                A - 2, 3.
*                B - 4.
 
 
 CIA      SA2    SSCP        GET SSCT ADDRESS
          SB4    B1          SET RETURN PARAMETER NON-ZERO
          AX2    12
          SA2    X2+         GET SUBSYSTEM CONTROL POINT TABLE ENTRY
          PL     X2,RB3      IF *IAF* NOT ACCESSIBLE
          SA3    VCPT*200B+STSW  CHECK FOR ERROR FLAG
          MX0    -12
          LX3    -36
          BX3    -X0*X3
          SB4    X3          INDICATE IF IAF IS ACCESSIBLE
          JP     B3          RETURN
 CJS      SPACE  4,20
**        CJS - CHECKS JOB STATUS FOR THE FOLLOWING ITEMS.
*
*         MODE ERRORS, PROGRAM STOPS, TIME AND SRU LIMITS.
*
*         ENTRY  (B4) = EXIT ADDRESS.
*                (B6) = EXCHANGE PACKAGE ADDRESS TO BE CHECKED.
*                (B7) = CONTROL POINT ADDRESS.
*
*         EXIT   EXITS TO SEF IF ERRORS DETECTED.
*
*         USES   X - 2, 3, 4, 6, 7.
*                A - 2, 3, 4.
 
 
 CJS      SA3    B6+B1       READ RA
          AX3    36
          SA2    B6          READ P
          SA4    A3+B1       READ FL
          AX2    36
          AX4    36
          IX7    X2+X3       RA + P
          IX6    X2-X4       P - FL
          PL     X6,CJS2     IF P .GE. FL
          AX6    X2,B1
          ERX1   X7          READ RA + P
          R=     X7,TLET     PRESET TIME LIMIT ERROR FLAG
          ZR     X6,CJS3     IF P = 0, 1
 CJS1     SA2    B7+SRUW     CHECK FOR LIMITS
          MX4    6
          BX6    X4*X1
          LX1    X2,B1
          ZR     X6,CJS2     IF PROGRAM STOP
          LX2    59-56
          BX4    X2+X1
          NG     X4,CJS5     IF LIMIT
          SA1    B7+STSW     READ CP STATUS
          TJP    (/MONITOR/CJS7,CP176,B4)
 
 CJS2     SX7    PSET        SET PROGRAM STOP ERROR FLAG
          JP     SEF
 
 CJS3     ZR     X2,CJS4     IF NOT SETCORE
          NZ     X1,CJS1     IF RA+1 NOT PROCESSED
 CJS4     SA4    A4+B1       CLEAR EXIT MODE BITS
          SA2    MABL        CHECK MAINFRAME TYPE
          MX6    2
          ERX3   X3          READ (RA)
          LX2    59-47
          LX6    -7
          AX3    51
          PL     X2,CJS4.5   IF CYBER 170-8X5
          BX6    -X6*X4
          SA6    A4
 CJS4.5   R=     X7,ARET
          ZR     X3,SEF      IF ARITHMETIC ERROR
          AX3    54-51       SHIFT OFF MODE FLAG BITS
          NZ     X3,SEF      IF NOT PARITY ERROR
          NG     X2,CJS4.6   IF CYBER 170-8X5
          LX2    20-16
 CJS4.6   PL     X2,SEF      IF NOT A CYBER 170
          SX7    PEET        SET PARITY ERROR
          EQ     SEF         SET ERROR FLAG
 
 CJS5     NG     X1,CJS6     IF TIME LIMIT
          SX7    SRET        SET SRU LIMIT FLAG
 CJS6     SA2    B7+TFSW     CHECK FOR INTERACTIVE JOB
          MX6    12
          BX6    X6*X2       EJT ORDINAL
          LX6    12
          CX2    X6,EJT      CONVERT EJT ORDINAL TO OFFSET
          MX6    -4
          TA2    X2+JSNE,EJT GET CONNECTION STATUS FROM EJT ENTRY
          AX2    7
          BX2    -X6*X2      CONNECTION STATUS
          SX6    OLCS
          BX6    X2-X6
          ZR     X6,RB4      IF ON-LINE INTERACTIVE JOB
          R=     X1,DTCS
          BX2    X1-X2
          ZR     X2,RB4      IF DETACHED INTERACTIVE JOB
          TA2    SP          CHECK PSEUDO-PP IR
          SX4    7600B       CONTROL POINT MASK
          SX3    B7
          AX2    36-7
          BX2    X4*X2
          BX3    X2-X3
          ZR     X3,RB4      IF PSEUDO-PP ASSIGNED TO THIS C.P.
          EQ     SEF         SET ERROR FLAG
 CPT      SPACE  4,30
**        CPT - UPDATE CPU TIME AND SRU ACCUMULATOR.
*
*         CP = S0 * CP0 * SC  +  S1 * CP1 * SC
*                S0 = SITE DEFINABLE CPU MULTIPLIER FOR CPU 0.
*                S1 = SITE DEFINABLE CPU MULTIPLIER FOR CPU 1.
*                CP0 = CPU TIME USED BY CPU 0 IN MACHINES UNITS.
*                CP1 = CPU TIME USED BY CPU 1 IN MACHINES UNITS.
*                SC = SCALING FACTOR TO CONVERT MACHINES UNITS INTO
*                     QUARTER NANOSECONDS.
*                MACHINE UNITS ARE MILLISECONDS FOR CYBER 6000,
*                CYBER 70 AND CYBER 171 - 175 MAINFRAMES.
*                MACHINE UNITS ARE 27.5 NANOSECONDS FOR CYBER 176.
*                MACHINE UNITS ARE MICROSECONDS FOR CYBER 8X5.
*
*         NEW SRU = CPM*CP + OLD SRU
*
*         ENTRY  (B3) = EXIT ADDRESS.
*
*         EXIT   (X1) = *CPAL* SHIFTED LEFT CIRCULAR 36 BITS.
*                (X6) = UPDATED CP ACCUMULATOR (QUARTER NANO SECONDS)
*                (X0) = CPU TIME SINCE CPU SWITCH IN MACHINE UNITS.
*
*         USES   X - 0, 1, 2, 3, 6, 7.
*                B - 4, 6.
*                A - 1, 2, 3, 6, 7.
 
 
 CPT      SA1    RTCL        READ MACHINE UNITS
          SA2    CL+CPBT+A0  READ BASE TIME
          MX7    -36
          BX6    -X7*X1      MILLISECOND CLOCK
          SA6    A2          SET NEW BASE TIME
          IX0    X6-X2       TIME USED IN MACHINE UNITS
 
*         ENTER HERE IF OTHER THAN MILLISECOND CLOCK USED.
*         (X0) = CPU TIME INCREMENT IN MACHINE UNITS.
 
 CPT1     SA1    CPAL+A0
          SA2    SA+A0
          SA3    CPTA+A0
          LX1    -42
          IX6    X2+X0
          IX3    X3*X0       SCALE CPU TIME FOR CPU TYPE
          SX2    X1          EXCHANGE PACKAGE TYPE
          SA6    SA+A0       UPDATE TIME ACCUMULATED SINCE CPU SWITCH
          BX0    X6
          NZ     X2,CPT5     IF INTERNAL *CPUMTR* EXCHANGE PACKAGE
 
*         UPDATE CPU TIME AND SRU ACCUMULATOR.
 
          LX1    18          POSITION CONTROL POINT ADDRESS
          SA2    CPTW+X1     READ CONTROL POINT ACCUMULATOR
          IX6    X3+X2
          SA6    A2
          SA2    X1+CPLW     READ TIME LIMIT WORD
          IX7    X2-X6
          PX3    X3
          NG     X7,CPT4     IF TIME LIMIT
 CPT2     SA2    X1+MP3W     READ CPM
          NG     X2,RB3      IF SRU ACCUMULATION DISABLED
          AX2    30
          PX2    X2
          NX7    X3
          NX2    X2
          SA3    CPTB        CONVERT TO MILLIUNITS
          RX2    X2*X7       CPM*CP
          RX2    X2*X3       CPM * CP / 4000000
          SA3    X1+SRUW     READ SRU ACCUMULATOR
          UX2,B4 X2
          LX2    B4
          IX7    X3+X2
          SA7    A3
          SA3    X1+STLW     READ SRU LIMIT
          MX2    -42
          BX7    -X2*X7
          BX3    -X2*X3
          IX3    X7-X3
          PL     X3,CPT3     IF SRU LIMIT
          JP     B3          RETURN
 
 CPT3     SA2    X1+SRUW     SET SRU LIMIT FLAG
          SX7    B1
          BX3    X2
          LX7    56
          LX3    59-53
          NG     X3,RB3      IF RESOURCE LIMITS DISABLED
          BX7    X2+X7
          SA7    A2
          JP     B3          RETURN
 
 CPT4     SA2    X1+SRUW     SET TIME LIMIT FLAG
          BX7    X2
          LX7    59-53
          NG     X7,CPT2     IF RESOURCE LIMITS DISABLED
          SX7    B1
          LX7    58
          BX7    X2+X7
          SA7    A2
          EQ     CPT2        CHECK SRU LIMIT
 
*         UPDATE CPU TIME FOR INTERNAL *CPUMTR* EXCHANGE PACKAGE.
 
 CPT5     LX1    42          POSITION EXCHANGE PACKAGE ADDRESS
          SA2    X1+CTMW     UPDATE ACCUMULATOR
          IX6    X2+X3
          LX1    -24         POSITION *CPAL* TO CONTROL POINT
          SA6    A2
          JP     B3          RETURN
 
 CPTA     CON    4000000     QUARTER NANOUNITS PER MACHINE UNIT * S0
          CON    4000000     QUARTER NANOUNITS PER MACHINE UNIT * S1
 
 CPTB     DATA   0.25E-6     MILLISECONDS PER QUARTER NANOSECOND
 CPTC     CON    4000000.0   QUARTER NANOUNITS PER MILLISECOND
 EFP      SPACE  4,20
**        EFP - EXECUTE FUNCTION POST PROCESSOR OVERLAY.
*
*         ENTRY  (X5) = 12/0, 48/OUTPUT REGISTER RESPONSE.
*                (X7) = OVERLAY CALL PARAMETERS.
*                (B4) = OVERLAY PLD POINTER.
*                (B3) = RETURN ADDRESS.
*
*         EXIT   OUTPUT REGISTER RESPONSE SET IN WORD *SBFP + 0* IN
*                  EXTENDED PP COMMUNICATION BLOCK.
*                PARAMETERS SET IN WORD *SBFP + 1* OF EXTENDED PP
*                  COMMUNICATION  BLOCK.
*                *BOTM* FUNCTION ISSUED TO PP.
*                TO *HNG* IF OVERLAY NOT CM RESIDENT.
*
*         *BOTM* FUNCTION FORMAT -
*
*         12/ *BOTM*,24/ OVERLAY CODE FWA,24/ *SBFP + 2* ADDRESS
*
*         USES   X - 1, 2, 3, 4, 7.
*                A - 1, 3, 4, 7.
 
 
 EFP      BSS    0           ENTRY
 
*         SET PARAMETERS AND OUTPUT REGISTER RESPONSE.
*         A *PRLM* WILL BE SET IN THE OUTPUT REGISTER IF THERE IS A
*         MOVE REQUEST FOR THE CP/PCP IN CASE STORAGE MOVE HAD BEEN
*         ENABLED PREVIOUSLY.
 
          TX3    A5-1,-FP
          SA1    CMCL
          LX3    PPXES-PPCES
          TA3    X3+ACPP,FPX GET CP/PCP ASSIGNMENT
          SA4    B4          GET PLD POINTERS
          SA7    A3+SBFP+1-ACPP  SET CALL PARAMETERS
          BX3    X3-X1
          BX7    X5
          AX3    48
          SX1    A7+B1       COMMUNICATION BLOCK POINTER FOR CALL
          NZ     X3,EFP1     IF NO MOVE REQUEST FOR CP/PCP
          SX2    PRLM        SET PAUSE REQUEST
          LX2    48
          BX7    X7+X2
 EFP1     AX4    24
          SA7    A7-B1       SET OUTPUT REGISTER
 
*         ISSUE *BOTM* FUNCTION TO PP.
 
          SX4    X4+1-400000B
          SX7    BOTM
          LX4    24          OVERLAY CODE FWA
          LX7    48
          BX4    X4+X1
          BX7    X7+X4
          SA7    A5+         SET *BOTM* FUNCTION AND PARAMETERS
          JP     B3          RETURN
 EPR      SPACE  4,15
**        EPR - ENTER PROGRAM REQUEST.
*         THIS ROUTINE CAN ONLY BE ENTERED FROM CPU-0 IF BOTH
*         CPU-S ARE IN USE.  THIS INSURES THAT *PR* IS
*         INTERLOCKED PROPERLY.
*
*         ENTRY  (X0) = REQUEST BIT.
*
*         USES   X - 2, 6.
*                B - 3, 6.
*                A - 2, 6.
*
*         CALLS  RCC.
 
 
 EPR      SA2    PR          SET REQUEST BIT
          SB3    MTRX        SET *RCC* RETURN ADDRESS
          TB6    SCA         SET EXCHANGE PACKAGE ADDRESS
          BX6    X2+X0
          SA6    A2
          EQ     RCC         RECALL CPU
 IAA      SPACE  4,40
**        IAA - INCREMENT AUC ACCUMULATOR.
*
*         PARAMETER BLOCK FORMAT -
*
*T ADDR   6/ BC,22/ 0,32/ CP
*T ADDR+1 10/ 0,10/ MS,10/ 0,10/ MT,10/ 0,10/ PF
*T ADDR+2 10/ 0,10/ OD,20/ MP,20/ AU
*T ADDR+3 36/ 0,12/ EM,12/ CM
*
*         BC = BLOCK CODE = 01B.
*         CP = CP TIME (QUARTER NANOUNITS).
*         MS = MS UNITS.
*         MT = MT UNITS.
*         PF = PF UNITS.
*         OD = OD UNITS.
*         MP = MP UNITS.
*         AU = AUC MILLIUNITS.
*         EM = EXTENDED MEMORY SIZE/1000B.
*         CM = CENTRAL MEMORY SIZE/100B.
*
*         SRU INCREMENT =
*
*             M1(CP + M2*IO + M3(CP+IO)CM +
*                M4(CP+IO)EC + MM*MP + AU)
*
*           = M1((1 + M3*CM + M4*EC)CP +
*                (M2 + M3*CM + M4*EC)IO + MM*MP + AU)
*
*           = (M1 + M1*M3*CM + M1*M4*EC)CP +
*                (M1*M2 + M1*M3*CM + M1*M4*EC)IO + M1*MM*MP + M1*AU
*
*           = CPM*CP + IOM*IO + M1M*MP + M1*AU.
*
*         AUC INCREMENT = SRU INCREMENT / M1.
*
*         ENTRY  (B3) = EXIT ADDRESS.
*                (B7) = CONTROL POINT AREA ADDRESS.
*                (X2) = ABSOLUTE PARAMETER BLOCK ADDRESS.
*
*         EXIT   (B3) = EXIT ADDRESS.
*                (B4) = OVERFLOW FLAG.
*                (B5) = 0, IF NO ERROR.
*                     = 1, IF EXCESSIVE INCREMENT.
*                (B7) = CONTROL POINT AREA ADDRESS.
*                (X5) = PRESERVED.
*                TO *AIO1* TO INCREMENT SRU ACCUMULATOR.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 6.
*                B - 4, 5, 6, 7.
 
 IAA      BX3    X2          GET PARAMETER BLOCK CODE
          ERX3   X3
          MX6    6
          BX6    X6*X3
          LX6    6
          SB4    X6
          SB5    B0+         SET NO ERROR
          EQ     B4,B1,IAA1  IF CODE = 01
          JP     B3          EXIT
 
 IAA1     SA1    B7+MP2W     M1*1000
          LX1    36
          MX0    -18
          BX6    -X0*X1      M12
          AX1    18
          BX1    -X0*X1      M1*1000
          SB4    X1          SAVE M1*1000
          SX4    3           GET *EM* AND *CM*
          IX4    X2+X4
          ERX4   X4
          SB6    X6          SAVE M12
          MX6    -12
          BX1    -X6*X4      CM/100B
          AX4    12
          BX7    -X6*X4      EM/1000B
          MX6    -3
          IX1    X1-X6       ROUND CM/100B WITH 7B
          AX1    3           CM = (CM/100B + 7B)/10B
          SB5    X1          SAVE CM/1000B
          ERRNZ  MP2W-MP1W-1 CODE DEPENDS ON CONTIGUOUS WORDS
          SA1    A1-B1       GET M13 AND M14
          LX1    36
          BX6    -X0*X1      ISOLATE M14
          IX7    X7*X6       M14 * EM/1000B
          AX1    18
          BX1    -X0*X1      ISOLATE M13
          SX6    B5          CM/1000B
          IX1    X6*X1       CM/1000B * M13
          IX1    X1+X7       M13*CM + M14*EC
          BX7    X1
          MX6    -54         CHECK *CP* SIZE
          BX4    -X6*X3
          MX6    -32         ISOLATE *CP*
          BX3    -X6*X3
          IX6    X4-X3
          NZ     X6,IAA7     IF INCREMENT TOO LARGE
          SX6    B4          M1*1000
          IX1    X1+X6       M1*1000 + M13*CM + M14*EC
          PX3    X3
          PX1    X1
          NX4    X3
          NX1    X1
          SA3    CPTB        CONVERT TO MILLIUNITS
          RX1    X1*X4       CPM * CP
          RX1    X1*X3       CPM * CP / 4000000
          UX1,B5 X1
          LX1    B5
          SX4    B1+B1       GET *AU* AND *MP*
          IX4    X2+X4
          ERX4   X4
          MX0    -20
          BX6    -X0*X4      *AU*
          SX3    B4
          IX6    X3*X6       M1*1000 * AU
          IX1    X6+X1       CPM*CP + M1*1000*AU
          LX4    20
          BX6    -X0*X4      *OD* (SET FOR IO LOOP INITIAL PASS)
          SA3    B7+MPMW     GET M1 * MAP MULTIPLIER
          LX4    20
          BX4    -X0*X4      *MP*
          LX3    20
          BX3    -X0*X3
          IX3    X3*X4       MP * M1M
          IX1    X1+X3       CPM*CP + M1*1000*AU + MP*M1M
          SX3    B6+         M12
          IX7    X7+X3       M12 + M13*CM + M14*EC
          PX7    X7
          NX7    X7
          SX4    B1+         GET *IO* COMPONENTS
          IX4    X4+X2
          ERX4   X4
          SB5    B0+         INITIALIZE INDEX
          LX4    20
 IAA2     MX3    -10
          ZR     X6,IAA3     IF NO INCREMENT
          LX3    10
          BX3    -X3*X6
          NZ     X3,IAA7     IF INCREMENT TOO LARGE
          PX6    X6
          SA3    B5+AIOA     GET MULTIPLIER
          NX6    X6
          RX6    X3*X6       IO = (S2, S3, S4, S5) * (MS, MT, PF, OD)
          RX3    X6*X7       IOM*IO
          UX3,B6 X3
          LX3    B6
          IX1    X1+X3
 IAA3     LX4    -20
          BX6    -X0*X4      ISOLATE INCREMENT
          SB5    B5+1
          SB6    4
          NE     B5,B6,IAA2  IF MORE *IO* COMPONENTS
          BX4    X1          DIVIDE BY M1*1000 FOR AUC INCREMENT
          SX3    B4
          SB4    B7          SAVE CONTROL POINT ADDRESS
          IX6    X4/X3       AUC INCREMENT
          SB7    B4          RESTORE CONTROL POINT ADDRESS
          MX0    19          CHECK FOR INCREMENT TOO LARGE
          BX3    X0*X1
          NZ     X3,IAA7     IF SRU INCREMENT TOO LARGE
          MX0    31
          BX3    X0*X6
          NZ     X3,IAA7     IF AUC INCREMENT TOO LARGE
 
*         ADD INCREMENT TO AUC ACCUMULATOR.
 
          SB4    40B         PRESET OVERFLOW FLAG
          SA2    B7+AUCW     GET AUC ACCUMULATOR
          BX3    -X0*X2
          IX3    X3+X6       ADD INCREMENT
          BX7    X0-X3
          NZ     X7,IAA4     IF NOT MAXIMUM
          SX3    B0+         SET ACCUMULATOR = 0
          EQ     IAA6        SET NEW ACCUMULATOR VALUE
 
 IAA4     BX7    X0*X3       CHECK FOR OVERFLOW
          ZR     X7,IAA5     IF NO OVERFLOW
          BX3    -X0*X3      INCREMENT TO OVERFLOW VALUE - MAXIMUM
          EQ     IAA6        SET NEW ACCUMULATOR VALUE
 
 IAA5     SB4    B0+         CLEAR OVERFLOW FLAG
 IAA6     BX6    X0*X2       SET NEW VALUE INTO AUCW
          BX6    X6+X3
          SA6    A2
          SB5    B0          SET NO ERROR FOR RETURN
          EQ     AIO1        INCREMENT SRU ACCUMULATOR
 
 IAA7     SB5    B1+         SET EXCESSIVE INCREMENT ERROR
          JP     B3          EXIT
 IBF      SPACE  4,20
**        IBF - ISSUE *BOTM* FUNCTION.
*
*         *IBF* FORMATS AND ISSUES A *BOTM* FUNCTION TO *PPR* TO
*         EXECUTE AN OVERLAY PROGRAM VIA A BOOTSTRAP LOADER.  *IBF*
*         ALLOCATES A PP SAVE AREA, MOVES THE PP-S OUTPUT REGISTER AND
*         MESSAGE BUFFER TO IT, PRESETS A THREE-WORD BOOTSTRAP, SETS IT
*         IN THE PP SAVE AREA, AND THEN ISSUES THE *BOTM* TO THE PP.
*
*         THE PRESETTING USES INFORMATION LOCATED IN THE FOURTH WORD OF
*         THE BOOTSTRAP, DESCRIBED BELOW AS *BS+3*.
*
*         ENTRY  (X3) = 12/ 0, 24/ BP, 12/0, 6/OX, 6/BX.
*                       BP = *BOTM* PARAMETERS FOR BYTES 3 AND 4.
*                       OX = *TFPL* INDEX OF OVERLAY.
*                       BX = *TFPL* INDEX OF BOOTSTRAP.
*                (A5) = *OR* ADDRESS.
*                (B5) = RETURN ADDRESS IF *SYSEDIT* ACTIVE OR NO PP
*                         SAVE AREA AVAILABLE.
*                (BS+3) = 12/2000B+PA, 48/ PP.
*                       PA = PRESET ALGORITHM.
*                       PP = PRESET PARAMETERS.
*                            WHEN A PP SAVE AREA IS USED, THIS FIELD
*                            MUST BE FORMATTED AS FOLLOWS.
*                            12/ L1, 12/ L2, 12/ F1, 12/ F2.
*                            L1 = LENGTH OF THE FIRST BLOCK SAVED.
*                            L2 = LENGTH OF THE SECOND BLOCK SAVED.
*                            F1 = FIRST BYTE ADDRESS OF FIRST BLOCK.
*                            F2 = FIRST BYTE ADDRESS OF SECOND BLOCK.
*                            *DSDI* USES THIS INFORMATION.
*
*         EXIT   TO *SPL* IF BOOTSTRAP CAN BE EXECUTED.
*                TO *B5* RETURN ADDRESS VIA *REJ* IF BOOTSTRAP CANNOT
*                  BE EXECUTED.
*
*         USES   X - 0, 1, 3, 4, 5, 6, 7.
*                A - 1, 3, 4, 6, 7.
*                B - 4, 6.
*
*         CALLS  MSM, MSR, SPL.
 
 
 IBF      BSS    0           ENTRY
          MX4    -6
          BX4    -X4*X3
          AX3    6
          SX1    X3
          SA4    X4+TFPL-1   GET BOOTSTRAP *TFPL* ENTRY
          SA1    X3+TFPL-1   GET OVERLAY *TFPL* ENTRY
          SX6    X4
          SX7    X1
          ZR     X6,REJ      IF BOOTSTRAP ENTRY NOT INITIALIZED
          ZR     X7,REJ      IF OVERLAY ENTRY NOT INITIALIZED
          LX7    18
          BX6    X6+X7
          SA6    T1          SAVE PLD POINTERS
 
*         ALLOCATE PP SAVE AREA FOR OVERLAY CALL.
 
          SA1    PPSP        GET PP SAVE AREA POINTER
          MX7    -12
          BX7    -X7*X1      GET NUMBER OF SAVE AREAS
          AX1    12
          SA1    X1-PPSA
          SX0    A5+         SET MOVE SOURCE ADDRESS
 IBF1     SA1    A1+PPSA     GET SAVE AREA INTERLOCK WORD
          SX7    X7-1
          NG     X7,REJ      IF NONE AVAILABLE
          NZ     X1,IBF1     IF THIS SAVE AREA IS INTERLOCKED
          SX5    A1+B1       SET MOVE DESTINATION ADDRESS
          TSB4   (7,CME,7,CMUMTR,10B)  SET MOVE WORD COUNT
          IX1    X0-X5       SET MOVE DIFFERENCE
          SB6    IBF2        SET RETURN ADDRESS
          TJP    (/CME/MSR,CME,/MONITOR/MSM,CMUMTR,/MONITOR/MSR)
 
 IBF2     SA1    T1
          SX4    X1          RESTORE BOOTSTRAP PLD POINTER
          AX1    18          RESTORE OVERLAY PLD POINTER
 
*         BUILD BOOTSTRAP CALL.
 
          R=     X0,BOTM     BUILD *BOTM* FUNCTION
          AX3    6           POSITION *BOTM* PARAMETERS
          BX0    X0+X3
          SA4    X4          GET BOOTSTRAP PLD ENTRY
          LX0    24          POSITION THE *BOTM* PARAMETERS
          AX4    24          GET BOOTSTRAP FWA
          SB6    X4
          PL     B6,HNG      IF BOOTSTRAP IS NOT CM RESIDENT
          SA3    X4+4-400000B  GET BOOTSTRAP PRESET CONTROL WORD
          SX7    A5          BUILD THE PP SAVE AREA INTERLOCK
          SA4    A3-B1       GET LAST WORD OF BOOTSTRAP
          LX7    48          POSITION OUTPUT REGISTER ADDRESS
          UX6,B6 X3          GET PRESET ALGORITHM AND *BOTM* PARAMETERS
          SA3    A4-B1
          BX7    X7+X6
          SA1    X1+         GET OVERLAY PLD ENTRY
          SA7    X5-1        SET THE PP SAVE AREA INTERLOCK
          SX5    X5+7        FWA OF BOOTSTRAP IN PP SAVE AREA
          AX6    24          POSITION *BOTM* DATA
          BX7    X0+X5
          LX7    24
          IX7    X7+X6
          NZ     B6,HNG      IF UNUSED PRESET ALGORITHM INDEX
 
*         EXIT TO THE BOOTSTRAP PRESET CODE WITH THESE VALUES -
*
*         (A1) = ADDRESS OF OVERLAY-S PLD ENTRY.
*         (A3) = ADDRESS OF SECOND WORD OF BOOTSTRAP.
*         (A4) = ADDRESS OF LAST WORD OF BOOTSTRAP.
*         (B6) = PRESET INDEX.
*         (X1) = OVERLAY-S PLD ENTRY.
*         (X3) = SECOND WORD OF BOOTSTRAP.
*         (X4) = LAST WORD OF BOOTSTRAP.
*         (X5) = FWA OF BOOTSTRAP IN PP SAVE AREA.
*         (X7) = *BOTM* CALL WORD.
 
 
*         PRESET ALGORITHM 0.
*
*         (MB) = OVERLAY LOAD PARAMETERS FROM *SPL*.
*         (MB+1) = *BOTM* CALL WORD.
 
 
          BX6    X3
          SA3    A3-B1
          SB6    IBF3        *SPL* RETURN ADDRESS
          SA6    X5+B1
          BX5    X7
          SA7    A5+2        SAVE *BOTM* CALL IN *MB*+1
          BX7    X4
          MX4    18
          SA7    A6+B1
          MX7    6
          BX6    X3
          BX7    X7*X1
          SA6    A6-B1
          LX7    -54
          EQ     SPL1.1      BUILD LOAD PARAMETERS
 
 IBF3     SA7    A5+B1       SAVE LOAD PARAMETERS IN *MB*
          BX7    X5          RESTORE *BOTM*
          EQ     PPR1        ISSUE *BOTM*
 JAV      SPACE  4,40
**        JAV - JOB ADVANCE.
*
*         CONDITIONS REQUIRED FOR ADVANCE-
*
*         ROLLOUT FLAG SET-
*         1)     NO PP,S ASSIGNED.
*         2)     EJT ENTRY INTERLOCK NOT SET.
*         3)     NO ROLLOUT INHIBITING RECALL REQUESTS.
*                IE. ENTRIES IN BQ OR CQ.
*         4)     EJT ORDINAL IN *TFSW* OF CONTROL POINT.
*         5)     STORAGE MOVE NOT PENDING FOR THIS CP.
*         6)     LEVEL 3 DEADSTART NOT IN PROGRESS.
*
*         IF ROLLOUT FLAG NOT SET-
*         1)     NO PP,S ASSIGNED.
*         2)     EJT ENTRY INTERLOCK NOT SET.
*         3)     NO CPU ACTIVITY.
*         4)     NO PP IN RECALL.
*         5)     NO TAPE ACTIVITY.
*         6)     NO WAIT RESPONSE/LONG TERM CONNECTION SET. (IF ERROR
*                FLAG IS SET, OR *END* IS IN (RA+1) THIS CONDITION
*                DOES NOT INHIBIT ADVANCE.)
*         7)     EJT ORDINAL IN *TFSW* OF CONTROL POINT.
*         8)     STORAGE MOVE NOT PENDING FOR THIS CP.
*         9)     LEVEL 3 DEADSTART NOT IN PROGRESS.
*
*         ENTRY  (B3) = EXIT ADDRESS.
*                (B7) = CP ADDRESS.
*
*         EXIT   NONE
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                B - 4.
*                A - 1, 2, 4, 7.
*
*         CALLS  APQ, /PCP/APC, RB3.
 
 
 JAV      BSS    0           ENTRY
          SA2    DSSL        CHECK FOR DEADSTART IN PROGRESS
          SA1    B7+STSW
          MX6    -3
          BX6    -X6*X2
          SX6    X6-7
          ZR     X6,RB3      IF A LEVEL 3 DEADSTART IN PROGRESS
          SX6    7377B
          LX6    -12
          BX3    X6*X1
          MX6    12
          NZ     X3,RB3      IF ACTIVITY REMAINS
          SA2    SMRL
          MX4    -12
          BX2    -X4*X2
          LX2    7           CONVERT CP NUMBER TO CPA ADDRESS
          SB4    X2
          EQ     B4,B7,RB3   IF MOVE PENDING FOR THIS CP
          SX2    7400B
          LX6    12+11
          BX3    X2*X1
          LX1    59-24
          LX2    -4+35       POSITION TO RECALL COUNT
          NG     X1,JAV1     IF ROLLOUT SET
          BX4    X6*X1
          BX3    X1*X2       EXTRACT RECALL COUNT
          NZ     X4,JAV1     IF ERROR FLAG
          SA4    B7+SSCW
          ZR     X4,JAV1     IF NO SUBSYSTEM CONNECTIONS
          SA2    B7+FLSW     READ RA/FL
          MX6    -12
          BX4    -X6*X2
          ZR     X4,RB3      IF NO FIELD LENGTH
          LX2    -12
          MX6    -RMSK
          BX2    -X6*X2      EXTRACT RA
          SX6    B1
          LX2    6
          IX2    X2+X6
          ERX2   X2          READ (RA+1)
          LX2    18
          SX2    X2-3REND
          NZ     X2,RB3      IF NOT END IN RA+1
 JAV1     NZ     X3,RB3      IF ACTIVITY REMAINS
          SA4    B7+TFSW     GET EJT ORDINAL
          MX6    -12
          LX4    -48
          BX2    -X6*X4      EJT ORDINAL
          CX4    X2,EJT      CONVERT EJT ORDINAL TO OFFSET
          ZR     X2,RB3      IF NO JOB AT CP
          TA4    X4+JSNE,EJT
          SX7    101B        JOB ADVANCE AND INTERLOCK MASK
          BX6    X7*X4
          BX7    X4+X7       SET JOB ADVANCE AND INTERLOCK
          NZ     X6,RB3      IF JOB ADVANCE OR INTERLOCK ALREADY SET
          SA7    A4
          LX1    59-31-59+24
 JAVA     TNG    X1,(/PCP/APC,PCP,/MONITOR/JAV2)  IF PSEUDO-ROLL OK
*         EQ     /TRACE/TRP13  (DURING DEAD JOB TRAP EXECUTION)
 JAV2     SX6    3R1AJ
          R=     B4,LA1AJ    SET *1AJ* INDEX
          LX6    42
          EQ     APQ         ASSIGN *1AJ*
 PCQ      SPACE  4,10
**        PPQ - PROCESS PP REQUEST QUEUE.
*
*         ENTRY  NONE.
*
*         EXIT   TO MTRX.
*
*         CALLS  APQ.
 
 
 PPQ      SA1    PQ+TAQR     SET START OF QUEUE
          SA2    SCRL        CHECK EMERGENCY STEP
          AX1    18
          SX0    X1
          LX2    59-56
          SB3    PPQ2        *APQ* RETURN ADDRESS
          NG     X2,MTRX     IF EMERGENCY STEP SET
 PPQ1     SA1    X0+         FIND NEXT ENTRY IN QUEUE
          SX1    X1
          SA2    PPAL
          ZR     X1,MTRX     IF NO PP REQUEST
          SX0    X0
          LX0    36
          BX0    X0+X1
          MX4    20
          LX4    -12
          BX2    X4*X2
          ZR     X2,MTRX     IF NO PP AVAILABLE
          SA4    X1+REPW-RCCW  GET PARAMETER WORD
          MX7    -12+7       CONTROL POINT AREA ADDRESS MASK
          BX6    X4
          SA6    APQA
          SA4    X1+RECW-RCCW  READ PP REQUEST
          LX7    7
          BX6    X4
          BX7    -X7*X1
          SB4    -B3         SELECT RETURN IF PP UNASSIGNABLE
          SB7    X7+
          BX1    X1-X1
          EQ     APQ1        ASSIGN PP
 
 PPQ2     SA2    X0          CHECK FOR PRIORITY PP REQUEST
          BX6    X1
          BX3    X2
          MX7    -18
          AX3    18
          BX3    -X7*X3
          NG     X2,PPQ2.1   IF A NO ROLL REQUEST
          ZR     X3,PPQ3     IF NOT PRIORITY PP REQUEST
          ZR     X1,PPQ4     IF PP NOT ASSIGNED
          LX6    36          RETURN ASSIGNMENT ADDRESS
          SA6    X3+
 PPQ2.1   SX3    -400B       SET DECREMENT FOR INHIBIT ROLLOUT COUNT
 PPQ3     ZR     X1,PPQ1     IF NO PP AVAILABLE
          AX0    36
          SA1    X0          DELETE ENTRY FROM QUEUE
          BX6    -X7*X2
          BX1    X7*X1
          BX6    X1+X6
          SA6    A1
          MX4    -4
          BX6    X6-X6
          SA1    B7+STSW     ADD RECALL SLOT TO FREE LIST
          SX3    X3-20B-RCCW+1
          SA6    A2+RECW-RCCW
          SA6    A2+REPW-RCCW
          BX7    -X4*X1
          BX1    X4*X1
          SX4    A2-B7       COMPUTE RECALL INDEX
          SA7    A2
          IX4    X4+X3
          IX7    X4+X1       SET NEW FREE ENTRY AND RECALL COUNT
          SA7    A1+
          EQ     PPQ1        PROCESS NEXT QUEUE ENTRY
 
 PPQ4     BX6    X6-X6
          SA6    X3          RETURN RESPONSE TO WAITING PP
          SX1    B1+
          SX3    -400B       SET DECREMENT FOR INHIBIT ROLLOUT COUNT
          EQ     PPQ3        DELETE FROM QUEUE
 RB3      SPACE  4,10
**        RB3 - RETURN TO ADDRESS IN (B3).
*
*         ENTRY  (B3) = EXIT ADDRESS.
 
 
 RB3      JP     B3          RETURN
 RB4      SPACE  4,10
**        RB4 - RETURN TO ADDRESS IN (B4).
*
*         ENTRY  (B4) = EXIT ADDRESS.
 
 
 RB4      JP     B4          RETURN
 RB5      SPACE  4,10
**        RB5 - RETURN TO ADDRESS IN (B5).
*
*         ENTRY  (B5) = EXIT ADDRESS.
 
 
 RB5      JP     B5          RETURN
 RB6      SPACE  4,10
**        RB6 - RETURN TO ADDRESS IN (B6).
*
*         ENTRY  (B6) = EXIT ADDRESS.
 
 
 RB6      JP     B6          RETURN
 RCC      SPACE  4,20
**        RCC - RECALL CPU.
*
*         THIS ROUTINE MAKES THE REQUESTED JOB OR EXCHANGE PACKAGE A
*         CANDIDATE FOR THE CPU.  A CPU SWITCH REQUEST WILL BE ENTERED
*         IN *CSWL* FOR THE CURRENTLY EXECUTING OR THE ALTERNATE CPU IF
*         THE JOB IN THAT CPU CAN BE IMMEDIATELY PREEMPTED.  A SWITCH
*         REQUEST FOR THE CURRENT CPU WILL BE PROCESSED DIRECTLY BY
*         *CPUMTR* ON EXIT FROM MONITOR MODE.  A SWITCH REQUEST FOR THE
*         ALTERNATE CPU WILL BE DETECTED AND PROCESSED THE NEXT TIME
*         THE ALTERNATE CPU EXITS FROM MONITOR MODE OR WILL BE
*         INITIATED BY *MTR*.
*
*         ENTRY  (B3) = EXIT ADDRESS.
*                (B6) = EXCHANGE PACKAGE ADDRESS.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                B - 4, 5.
*                A - 1, 2, 3, 4, 6, 7.
 
 
 RCC      BSS    0           ENTRY
          SA1    B6+STSW     GET CPU STATUS
          MX4    1           BUILD *W* STATUS
          MX2    -57
          BX6    -X2*X1      CLEAR OLD STATUS
          BX2    X2*X1       STATUS CODE
          LX1    59-24
          LX2    3
          BX6    X6+X4
          SB4    X2+
          SB4    -B4         NEGATIVE STATUS CODE
 
*         THE FOLLOWING IS A JUMP TABLE INDEXED BY CPU STATUS
*         IN REVERSE ORDER.
 
 RCCA     NG     X1,RCC15    IF ROLLOUT SET
          JP     RCCA+7+B4   JUMP TO PROCESSOR, LOOP FOR STATUS = 7
 
+         SA6    A1+         6 = *I* STATUS, AUTO RECALL
          EQ     RCC7        ADD ENTRY TO WQ
 
+         SA3    B6+CRCW     5 = *X* STATUS, CPU RECALL
          EQ     RCC4        DELETE ENTRY FROM *RQ* AND ADD TO *WQ*
 
+         SA3    B6+CWQW     4 = *W* STATUS, WAITING FOR CPU
          EQ     RCC3        DELETE FROM *WQ* AND REINSERT
 
+         EQ     *           3 = ILLEGAL
 
+         SX1    B1          2 = *B* STATUS, CPU 1 ACTIVE ON JOB
          SX7    B1
          EQ     RCC2        SET RECALL FLAG
 
+         SX1    B0          1 = *A* STATUS, CPU 0 ACTIVE ON JOB
          SX7    B1
          EQ     RCC2        SET RECALL FLAG
 
+         LX1    12+24-59    0 = NULL STATUS, NO ACTIVITY
          AX1    48          EXTRACT ERROR FLAG
          NZ     X1,RB3      IF ERROR FLAG
          SA6    A1+         SET *W* STATUS
          EQ     RCC7        ENTER IN CPU REQUEST QUEUE
 
*         SET RECALL FLAG ON ACTIVE JOB TO ENFORCE RECALL CPU SLICE.
 
 RCC2     SA3    B6+CWQW
          SA1    TSCL+X1
          SX6    12B
          LX6    45
          LX7    48-0
          BX6    X3+X6       SET RECALL AND DRIVER FLAGS IN *CWQW*
          BX7    X1+X7       SET RECALL FLAG IN *TSCL*
          SA6    A3          UPDATE *CWQW*
          SA7    A1          UPDATE *TSCL*
          JP     B3          RETURN
 
*         DELETE ENTRY FROM *WQ*.
 
 RCC3     SX1    WQRL
          MX6    -18
          SX7    A3          SET *WQ* ENTRY ADDRESS
          EQ     RCC5        DELETE QUEUE ENTRY
 
*         DELETE ENTRY FROM *RQ*.
 
 RCC4     SX1    RQRL        5 = *X* STATUS, CPU RECALL
          SA6    A1          SET NEW CPU STATUS
          BX7    X7-X7
          MX6    -12
          SA7    A3          CLEAR *RQ* PARAMETERS
          SX7    A3+         SET *RQ* ENTRY ADDRESS
 
*         DELETE ENTRY FROM *RQ* OR *WQ*.
*         SEARCH LOOP REPLICATED FOR PERFORMANCE.
 
 RCC5     SA2    X1
          BX1    -X6*X2
          BX0    X7-X1
          SA4    X1
          ZR     X0,RCC6     IF ENTRY FOUND
          BX1    -X6*X4
          BX0    X7-X1
          NZ     X0,RCC5     IF ENTRY NOT FOUND
          SA2    A4+
 RCC6     BX2    X6*X2       DELETE LINK TO ENTRY
          BX3    -X6*X3      EXTRACT LINK FROM ENTRY
          BX7    X2+X3       SET LINK TO BYPASS ENTRY
          SA7    A2
 
*         SET RECALL FLAG AND CHECK CPU SLICE RESTART REQUIRED.
 
 RCC7     SA3    B6+CWQW     GET CPU SCHEDULING PARAMETERS
          SA4    B6+CSAW     GET SERVICE CYCLE AND ACCUMULATORS
          SX6    12B
          SX0    B1
          LX6    45
          LX0    26-0
          UX7,B4 X3          UNPACK CPU PRIORITY AND FLAGS
          SX1    B4
          BX3    X3+X0       SET *MTR* BYPASS FLAG
          AX1    3           CPU PRIORITY
          BX3    X3+X6       SET RECALL AND DRIVER FLAGS
          SA1    TPRC+X1     GET SERVICE CYCLE FOR PRIORITY
          SA2    WQRL
          LX0    47-26
          BX0    X0*X3       EXTENDED CPU SLICE INCOMPLETE FLAG
          MX7    6
          LX0    49-47
          BX4    X7*X4       CPU SERVICE CYCLE
          BX3    X3+X0       SET SLICE ACTIVE STATUS
          BX7    X7*X1       CURRENT SERVICE CYCLE
          BX1    X4-X7
          ZR     X1,RCC8     IF CPU SLICE IN CURRENT SERVICE CYCLE
 
*         RESTART CPU SLICE IN CURRENT SERVICE CYCLE.
 
          LX6    1
          SA7    B6+CSAW     SET SERVICE CYCLE AND CLEAR ACCUMULATORS
          BX3    X3+X6       SET ACTIVE/INCOMPLETE SLICE FLAGS
 
*         INSERT JOB IN *WQ* WITH RECALL FLAG.
*         SEARCH LOOP REPLICATED FOR PERFORMANCE.
 
 RCC8     MX6    42
          SX7    A3+         SET CURRENT JOB WAIT QUEUE ADDRESS
          UX0,B4 X3          GET CPU PRIORITY AND FLAGS
 RCC9     SA4    X2
          UX0,B5 X4
          GT     B4,B5,RCC10 IF POSITION FOUND
          SA2    X4
          UX0,B5 X2
          LE     B4,B5,RCC9  IF POSITION NOT FOUND
          BX1    X6*X4       CLEAR LINK
          BX7    X1+X7       MERGE NEW LINK
          SX0    A2          SET LINK TO NEXT ENTRY
          SA7    A4
          EQ     RCC11       UPDATE LINK
 
 RCC10    BX1    X6*X2       CLEAR LINK
          BX7    X1+X7       MERGE NEW LINK
          SX0    A4          SET LINK TO NEXT ENTRY
          SA7    A2
 
*         SET RECALLED JOB *WQ* LINK AND CHECK CPU SWITCH CRITERIA.
*         IF THERE IS A SWITCH REQUEST FOR THE CURRENT CPU ON A DUAL
*         CPU SYSTEM, THE OTHER CPU WILL NOT BE CHECKED BY *RCC* SINCE
*         *BNJ* WILL PERFORM THIS CHECK ON EXIT FROM MONITOR MODE.
 
 RCC11    SA4    CSWL+A0
          SA1    TSCL+A0
          SA2    RTCL
          BX3    X6*X3       CLEAR POSSIBLE OLD LINK
          BX3    X3+X0       MERGE NEW LINK
          NO
          NO
          NG     X4,RCC14    IF PENDING SWITCH REQUEST FOR THIS CPU
          MX7    -36
          UX0,B5 X1          GET THIS CPU ACTIVE JOB PRIORITY
          BX1    -X7*X1
          BX2    -X7*X2
 RCCB     GT     B4,B5,RCC13 IF NEW JOB .GT. ACTIVE JOB
*         EQ     /DCP/RCC    (DUAL CPU MACHINE)
          LT     B4,B5,RCC14 IF NEW JOB .LT. ACTIVE JOB
 RCC12    IX6    X2-X1
          NG     X6,RCC14    IF RECALL SLICE NOT EXPIRED
 
*         WRITE *CWQW* AND REQUEST CPU SWITCH.
 
 RCC13    SX1    A3
          MX7    1
          LX1    36
          BX7    X4+X7       SET SWITCH REQUEST FLAG
          BX6    X3
          BX7    X7+X1       SET POINTER TO *WQ* ENTRY WITH BYPASS FLAG
          SA6    A3          WRITE *CWQW*
          SA7    A4          WRITE *CSWL*
          JP     B3          RETURN
 
*         CLEAR *MTR* BYPASS FLAG.
 
 RCC14    SX7    B1
          LX7    26-0
          BX6    -X7*X3      CLEAR BYPASS FLAG
          SA6    A3          WRITE *CWQW*
          JP     B3          RETURN
 
*         PROCESS RECALL REQUEST WITH ROLLOUT PENDING.
 
 RCC15    LX1    12+24-59
          SX2    B1
          AX1    48          EXTRACT ERROR FLAG
          LX2    25
          NZ     X1,RB3      IF ERROR FLAG SET
          BX6    X2+X6       SET CPU STATUS AT ROLLOUT
          LX2    59-25
          BX6    -X2*X6      CLEAR *W* STATUS
          SA6    A1          SET NULL STATUS
          JP     B3          RETURN
 RSC      SPACE  4,30
**        RSC - RETURN SUB-SYSTEM CONTROL POINT ADDRESS.
*
*         ENTRY  (X0) = -7777B
*                (X1) = SUBSYSTEM IDENTIFICATION.
*                (B3) = EXIT ADDRESS.
*                ((B3)-1) = EXIT ADDRESSES FOR ERROR CASES.
*                ((B3)-1) = 12/  A1-XA,18/  A2,12/  A3-XA,18/  A4
*                         XA = EXIT ADDRESS = (B3)
*                         A1 = EXIT ADDRESS IF SUB-SYSTEM NOT ACTIVE.
*                              NOTE - IF THE SUB-SYSTEM FL IS ZERO IT
*                              IS TREATED AS A NOT ACTIVE CONDITION.
*                         A2 = EXIT ADDRESS IF ILLEGAL SUBSYSTEM ID.
*                         A3 = EXIT ADDRESS IF JOB ADVANCE OR DMP= SET.
*                         A4 = EXIT ADDRESS IF STORAGE MOVE SET.
*                (B7) = CALLER,S CONTROL POINT ADDRESS.
*
*         EXIT   (X0) = -7777B
*                (X3) = SUB-SYSTEM RA.
*                (X6) = SUB-SYSTEM FL.
*                (A2) = STSW ADDRESS IN SUB-SYSTEM CONTROL POINT AREA.
*
*         USES   X - 1, 2, 3, 6.
*                B - 6.
*                A - 1, 2.
*
*         CALLS  RSI.
 
 
 RSC      SB6    RSC1        SET RETURN ADDRESS FOR *RSI*
          EQ     RSI1        RETURN SUBSYSTEM INFORMATION
 
*         RETURN FROM *RSI* IF ILLEGAL SUBSYSTEM IDENTIFICATION.
 
 RSC1     SA1    B3-B1       GET RETURN ADDRESS
          AX1    30
          EQ     RSC6        RETURN
 
*         RETURN FROM *RSI* WITH SUBSYSTEM INFORMATION.
 
+         SB6    X3          SHIFT COUNT
          AX2    B6
          LX2    -12
          MX3    -5
          PL     X2,RSC4     IF SUBSYSTEM NOT ACTIVE
          SA2    A2+SSCTL    GET *SSAT* WORD FOR THIS SUBSYSTEM
          AX2    B6
          BX6    -X0*X2      GET EJT ORDINAL OF SUBSYSTEM
          CX2    X6,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA2    X2+JSNE,EJT GET EJT ENTRY
          LX2    -1
          BX6    -X3*X2      GET JOB STATUS
          SX6    X6-EXJS
          LX2    59-6+1
          NZ     X6,RSC4     IF SUBSYSTEM NOT AT CONTROL POINT
          NG     X2,RSC7     IF JOB ADVANCE SET ON SUBSYSTEM
          SA2    A2+SCHE-JSNE  GET CONTROL POINT NUMBER
          AX2    12
          BX6    -X3*X2
          LX6    7           SUBSYSTEM CONTROL POINT ADDRESS
          SA2    X6+JCIW     READ JOB CONTROL
          AX2    24
          BX3    X2-X1
          SA1    SMRL        CHECK FOR STORAGE MOVE IN PROGRESS
          BX3    -X0*X3
          NZ     X3,RSC4     IF SUB-SYSTEM NOT ACTIVE
          BX1    -X0*X1
          LX1    7
          SA2    X6+STSW
          BX1    X1-X6
          ZR     X1,RSC5     IF SUBSYSTEM MOVING
 RSC2     SA1    A2+FLSW-STSW  GET RA AND FL
          BX6    -X0*X1      EXTRACT FL
          LX1    -RSHF
          ZR     X6,RSC4     IF ZERO FL - TREAT AS NOT ACTIVE
          MX3    -RMSK
          BX3    -X3*X1
          LX6    6
          LX3    6
          SA1    A2+SPCW-STSW CHECK DMP= PROCESSING
          AX1    48
          NZ     X1,RSC7     IF DMP= IN PROGRESS
          JP     B3
 
*         EXIT IF SUB-SYSTEM NOT ACTIVE.
 
 RSC4     SA1    B3-B1
          AX1    48
          EQ     RSC8        RETURN
 
*         EXIT IF MOVE FLAG SET.
 
 RSC5     SA1    B3-B1
          SB6    X6
          EQ     B6,B7,RSC2  IF CALLER,S CP .EQ. SUB-SYSTEM,S CP
 RSC6     SB3    X1
          JP     B3          RETURN
 
*         EXIT IF ADVANCE FLAG SET.
 
 RSC7     SA1    B3-1
          LX1    30
          AX1    48
 RSC8     SB3    B3+X1
          JP     B3          RETURN
 RSI      SPACE  4,15
**        RSI - RETURN SUBSYSTEM IDENTIFICATION.
*
*         ENTRY  (X0) = -7777B.
*                (X1) = SUBSYSTEM IDENTIFICATION IF ENTRY AT *RSI1*.
*                (B6) = RETURN ADDRESS IF NOT SUBSYSTEM.
*                       RETURN TO (B6)+1 WITH SUBSYSTEM INFORMATION.
*                (B7) = CONTROL POINT ADDRESS OF SUBSYSTEM IF
*                       ENTRY AT *RSI*.
*
*         EXIT   (A2) = ADDRESS OF *SSCT* WORD FOR THIS SUBSYSTEM.
*                (X1) = SUBSYSTEM IDENTIFICATION.
*                (X2) = *SSCT* ENTRY FOR THIS SUBSYSTEM.
*                (X3) = SHIFT COUNT TO POSITION TO BYTE IN *SSCT*
*                       WORD FOR THIS SUBSYSTEM INFORMATION.
*
*         USES   A - 2.
*                X - 1, 2, 3, 6.
 
 
 RSI      SA1    B7+JCIW     GET SUBSYSTEM IDENTIFICATION
          LX1    36
          BX1    -X0*X1
 RSI1     SX6    X1-LSSI-1
          NG     X6,RB6      IF NOT SUBSYSTEM
          SX6    X1-MXSI-1
          PL     X6,RB6      IF NOT SUBSYSTEM
          TX3    -1,SSCT     GET FWA - 1 OF *SSCT* TABLE
          SB6    B6+1        ADVANCE RETURN ADDRESS
 RSI2     SX6    X6+5
          SX3    X3+1
          NG     X6,RSI2     IF *SSCT* WORD NOT REACHED
          LX6    2
          SA2    X3          GET *SSCT* WORD FOR THIS SUBSYSTEM
          LX3    X6,B1
          IX3    X3+X6       SHIFT COUNT FOR SUBSYSTEM BYTE
          JP     B6          RETURN
 SCD      SPACE  4,10
**        SCD - SEARCH CENTRAL LIBRARY DIRECTORY.
*
*         ENTRY  (X2) = 42/ ENTRY POINT NAME, 18/
*                (B6) = RETURN ADDRESS.
*
*         EXIT   (X7) = ADDRESS OF PST.
*                (X7) = 0  IF NOT FOUND.
*
*         USES   X - 1, 2, 3, 4, 5, 7.
*                A - 1, 2.
*                B - 4, 5.
 
 
 SCD      SA1    EPDP        READ DIRECTORY ADDRESS
          MX4    42
          SX3    B1
          BX7    X4*X2       ENTRY POINT NAME
          AX1    36
          SA2    LBDP        FIND END OF DIRECTORY
          SB4    X1          FWA OF DIRECTORY
          AX2    12
          LX3    41-1
          IX2    X2-X3
          SB5    X2          LWA+1 OF DIRECTORY
          EQ     SCD2        ENTER LOOP
 
 SCD1     BX1    -X4*X1
          ZR     X5,SCD4     IF ENTRY POINT FOUND
          SB4    A1+B1       RESET FWA OF SEARCH
 SCD2     SX1    B5-B4       LENGTH OF SEARCH INTERVAL
          AX1    1
          EQ     B4,B5,SCD3  IF END OF SEARCH
          SA1    B4+X1       GET DIRECTORY ENTRY
          NO
          BX5    X4*X1       ENTRY POINT NAME
          IX5    X7-X5
          PL     X5,SCD1     IF PROGRAM .GE. SAMPLE ENTRY
          SB5    A1+
 SCD3     GT     B5,B4,SCD2  IF MORE DIRECTORY TO SEARCH
          SX7    B0+         CLEAR REPLY (ENTRY POINT NOT FOUND)
          JP     B6          RETURN
 
*         ENTRY POINT FOUND.
 
 SCD4     SA2    PSTP        GET FWA OF PST
          AX2    12
          BX2    -X4*X2
          IX7    X1+X2       ADDRESS OF PST ENTRY
          JP     B6          RETURN
 SEF      SPACE  4,15
**        SEF - SET ERROR FLAG.
*
*         ENTRY  (B7) = CP ADDRESS.
*                (X7) = ERROR FLAG.
*                JOB ACTIVE IN THIS CPU.
*
*         EXIT   TO *SSE* IF SUBCONTROL POINT ACTIVE.
*                TO *MTRX* IF NEW .LT. CURRENT ERROR FLAG.
*                TO *SNS* IN NORMAL CASE.
*
*         USES   X - 1, 2, 4, 6, 7.
*                A - 1, 6.
*                B - 3, 5.
*
*         CALLS  MSC.
 
 
 SEF      SA1    B7+STSW     READ CP STATUS
          BX6    X1
          LX1    59-56
 SEF1     TNG    X1,(/MONITOR/SSE,SUBCP,/MONITOR/SEF1)
          MX2    -12
          LX7    36
          LX2    36
          BX4    -X2*X6      GET OLD ERROR FLAG
          IX4    X7-X4
          ZR     X7,SEF2     IF NEW ERROR FLAG IS ZERO
          NG     X4,MTRX     IF OLD .GT. NEW ERROR FLAG
 SEF2     TB3    SCA
          EQ     B7,B3,SEF2.1  IF SYSTEM CONTROL POINT
          IX6    X6+X4
          SA6    A1
          EQ     SNS         SET NULL CPU STATUS
 
 SEF2.1   SA1    CPAL+A0
          AX1    42
          SX2    X1-IDXT
          SX1    SABT        * SYSTEM ABORT.*
          TPL    X2,(/MONITOR/SEF4,NVE,/MONITOR/SEF3)  IF IDLE PACKAGE
 
 SEF3     SB5    MTRX        SET EXIT ADDRESS FOR *MSC*
          EQ     MSC         SET MESSAGE AT SYSTEM CONTROL POINT
 
 SEF4     SB5    ZERL        ABORT AFTER POSTING MESSAGE
          EQ     MSC         SET MESSAGE AT SYSTEM CONTROL POINT
 SFL      SPACE  4,15
**        SFL - SET FIELD LENGTH.
*
*         ENTRY  (B5) = 0 IF NOT *MTR* CALL.
*                (B6) = EXCHANGE PACKAGE ADDRESS.
*                (B7) = CONTROL POINT ADDRESS IF .NE. 0.
*                (B7) = 0 IF CMR REQUEST FROM *MTR*.
*                (X0) = INCREMENT.
*
*         EXIT   TO *MTRX*.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                B - 3, 4.
*                A - 2, 3, 4, 6, 7.
*
*         CALLS  CJS, SJS, SRU.
 
 SFL      BSS    0           ENTRY
          SA2    A0+CPAL     FETCH CPU ASSIGNMENT DATA
          SA3    ACML
          SX6    B7
          BX7    -X0         COMPLEMENT INCREMENT
          AX2    24          POSITION CP ADDRESS
          LX7    36-6
          AX6    7-1
          IX7    X3+X7       ADJUST AVAILABLE MEMORY
          SB3    X2+
          SA6    UMTA        SET MCT INDEX FOR CP
          SA7    A3+
 
*         UPDATE EXCHANGE PACKAGE AND CP STATUS.
 
 SFL1     SA3    B7+FLSW     GET FL STATUS WORDS
          AX0    6
          SA4    A3+B1
          TA2    X6,MCT      FETCH MCT ENTRY
          MX1    -12
          IX6    X3+X0       UPDATE FIELD LENGTH
 +        SA6    A3
          IX7    X4+X0       MODIFY *FLSW* + 1
          BX6    -X1*X6
          SA7    A4          CHANGE CPA WORDS IN 1 WORD OF CODE
          SA3    B6+2
          IX7    X2-X0       ADJUST UNASSIGNED CM ABOVE CP/PCP
          SA7    A2
          ZR     B7,SFL2     IF CMR REQUEST
          MX7    -36
          BX4    -X7*X3      CLEAR OLD FL
          LX6    36+6
          BX6    X6+X4       UPDATE EXCHANGE PACKAGE FL
          SA6    B6+2
 SFL2     ZR     B5,SFL3     IF NOT *MTR* CALL
          SX6    0
          SA6    SMRL
          ZR     B7,MTRX     IF CMR REQUEST
 SFL3     NE     B3,B7,SFL4  IF CURRENT CPU NOT ACTIVE ON THIS JOB
          SB4    SFL4
          JP     CJS         CHECK JOB STATUS
 
*         UPDATE CM USAGE.
 
 SFL4     SB4    SJS
          NG     X0,SRU      IF FL DECREASE
          SB4    MTRX
          NZ     X0,SRU      IF FL INCREASE
          JP     MTRX        EXIT MONITOR MODE
 SIS      SPACE  4,10
**        SIS - SET *I* STATUS.
*
*         ENTRY  (B7) = CONTROL POINT ADDRESS.
*                JOB ACTIVE IN THIS CPU.
*
*         EXIT   TO *BNJ* BEGIN NEW JOB.
*
*         USES   X - 7.
 
 SIS      BSS    0           ENTRY
          SX7    ICPS        SET *I* STATUS FOR *BNJ* ENTRY
          EQ     BNJ         BEGIN NEW JOB
 SJS      SPACE  4,15
**        SJS - START JOB SCHEDULER.
*
*         EXIT   TO MTRX.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                B - 3, 4.
*                A - 1, 2, 3, 7.
*
*         CALLS  APQ.
*
*         PRESERVES  A5, B7, A0.
 
 
 SJS      SX7    B7+         SAVE CONTROL POINT ADDRESS
          TB7    SCA         SET SYSTEM CONTROL POINT ADDRESS
          SA7    T1
          SB6    SJS0        RETURN ADDRESS IF NO ACTIVITY LIMIT
          SB3    SJS3        RETURN ADDRESS IF ACTIVITY LIMIT
          EQ     CAL         CHECK ACTIVITY LIMIT
 
 SJS0     SA3    JSCL        READ SCHEDULER CONTROL WORD
          SA1    RTCL
          NG     X3,SJS3     IF SCHEDULER ACTIVE
          SA2    SJSA        READ *1SJ* CALL
          MX7    24
          AX1    36          EXTRACT TIME IN SECONDS
          MX0    -24
          BX7    X7*X2       CLEAR *1SJ* CALL FLAGS
          MX5    1
          SA7    A2
          ERRNZ  SJSB-SJSA-1 CODE ASSUMES *SJSB* = *SJSA* + 1
          SA4    A2+B1
          SA7    A4          RESET FORCED *JSCL* RESET FLAG
          BX7    X3+X5       SET SCHEDULER ACTIVE FLAG
          BX6    X2
          ZR     X4,SJS0.1   IF FORCED *JSCL* RESET
          BX4    -X0*X3      EXTRACT RECALL TIME
          IX4    X1-X4       *RTCL* - TIME TO RECALL
          NG     X4,SJS1     IF NOT TIME TO PERFORM PERIODIC RECALL
 SJS0.1   AX3    24          EXTRACT RECALL TIME PERIOD
          MX0    -12
          BX4    -X0*X3
          IX7    X7+X4       UPDATE TIME TO RECALL
          AX3    12          EXTRACT QFT/EJT SCHEDULING FREQUENCY
          BX4    -X0*X3
          SX3    B1+
          SB3    X4
          LX4    X3,B3       GENERATE FREQUENCY MASK
          IX4    X4-X3
          BX1    X4*X1
          NZ     X1,SJS1     IF NOT TIME FOR QFT SCHEDULING
          LX3    24
          BX6    X6+X3
 SJS1     SB3    SJS2        *APQ* RETURN ADDRESS
          SB4    LA1SJ       SET LOAD PARAMETER INDEX
          SA7    A3          STORE SCHEDULER CONTROL WORD
          EQ     APQ         ASSIGN PP
 
*         NOTE -
*                IN ORDER TO AVOID *DEADLOCK* (SORT OF) PROBLEMS
*         WITH THE *CPUCIO* REQUEST QUEUE, THE QUEUE IS CHECKED
*         PENDING REQUESTS ON EVERY *1SJ* CALL
 
 SJS2     SB3    SJS3        *PCQ* RETURN ADDRESS
          SB4    SJS3
          TNO    /BUFIO/PCQ1,BUFIO  PROCESS PSEUDO-PP REQUEST QUEUE
 
 SJS3     SA1    T1          RESTORE (B7)
          SB7    X1+
 
*         IF A PRIORITY PP REQUEST IS PENDING, THE ENTRY IS
*         CLEARED AND A REJECT STATUS IS SET TO THE WAITING PP.
 
          SA3    PQRL        CHECK FOR PENDING PRIORITY REQUEST
          ZR     X3,MTRX     IF NO PP REQUESTS IN QUEUE
          SA1    X3
          MX2    -18
          LX1    -18
          BX3    -X2*X1
          ZR     X3,MTRX     IF FIRST REQUEST NOT PRIORITY
          BX7    X7-X7       SEND REJECT RESPONSE TO WAITING PP
          SA7    X3
 
*         DELETE ENTRY FROM QUEUE.
 
          LX1    18
          MX4    -12
          BX6    -X4*X1      ADDRESS OF NEXT ENTRY
          SA6    A3
          SA7    A1+RECW-RCCW  CLEAR ENTRY FROM CONTROL POINT
          SA7    A1+REPW-RCCW
          SX1    A1
          AX1    7
          MX4    -4
          LX1    7           CONTROL POINT ADDRESS
          SA2    X1+STSW     ADD ENTRY TO FREE LIST
          SX3    -420B-RCCW+1
          SB4    X1
          BX7    -X4*X2      NEXT FREE ENTRY
          BX2    X4*X2
          SA7    A1
          SX4    A1-B4       COMPUTE RECALL INDEX
          IX4    X4+X3
          IX7    X4+X2
          SA7    A2          UPDATE STSW
          EQ     MTRX        EXIT
 
 
 SJSA     VFD    18/3R1SJ,6/0,12/0,12/0,12/0
 SJSB     CON    1           ZERO IF FORCED *JSCL* RESET
 SNS      SPACE  4,10
**        SNS - SET NULL STATUS.
*
*         ENTRY  (B7) = CONTROL POINT ADDRESS.
*
*         EXIT   TO *JAV* ADVANCE JOB.
*
*         CALLS  JAV.
 
 
 SNS      SA4    B7+STSW     CLEAR CPU STATUS
          SB3    BNJ1        *JAV* RETURN ADDRESS
          MX7    -57
          BX7    -X7*X4
          SA7    A4+
          EQ     JAV         ADVANCE JOB
 SPL      SPACE  4,20
**        SPL - SEARCH PERIPHERAL LIBRARY.
*
*         ENTRY  (X6) = PPU REQUEST.
*                (X5) = PP OUTPUT REGISTER IF *SPLM* CALL.
*                (B6) = EXIT ADDRESS.
*                     = EXIT ADDRESS + 400000B, IF REQUEST IS FOR CPP.
*
*         EXIT   LIBRARY UNLOCKED.
*                (X1) .GT. 0.
*                (X5) = 0 IF PROGRAM FOUND, ELSE *SFP* *PLD* ENTRY
*                RETURNED.
*                (X7) = PP LOAD PARAMETERS.
*                (A1) = ADDRESS OF PLD ENTRY.
*                (B6) = EXIT ADDRESS.
*
*                LIBRARY LOCKED (SYSEDIT ACTIVE)
*                (X1) = -0.
*                (X7) = (X5) ON ENTRY WITH BITS 56 AND 57 SET.
*
*         USES   X - 1, 3, 4, 5, 7.
*                B - 5.
*                A - 1, 7.
 
 
 SPL      SA1    PSTP        FIND END OF DIRECTORY
          MX4    18
          AX1    12
          SX3    X1-2
          SA1    PLDP        READ START OF DIRECTORY
          BX7    X4*X6       SET PROGRAM NAME
          AX1    36
          SB5    X1          FWA OF LIBRARY
          IX3    X3-X1       LIBRARY LENGTH
          NZ     B5,SPL1     IF LIBRARY NOT LOCKED
          SX3    44B         REJECT FUNCTION (SET RETRY/MOVABLE FLAGS)
          BX1    -X1+X1
          LX3    -6
          BX7    X5+X3
          TJP    (/CPP/SPL1,CPP,B6)  RETURN
 
 SPL1     SX2    B5+X3       RESET LWA OF LIBRARY
          ZR     X3,SPL4     IF END OF SEARCH
          AX3    1
          SA1    B5+X3       SAMPLE DIRECTORY ENTRY
          BX5    X4*X1
          IX5    X7-X5
          LX5    18          POSITION SIGN BIT
          NG     X5,SPL1     IF PROGRAM .LT. SAMPLE
          SB5    A1+B1       RESET FWA OF SEARCH INTERVAL
          SX3    B5          RESET LENGTH
          IX3    X2-X3
          NZ     X5,SPL1     IF PROGRAM NOT FOUND
          LX7    -54
 
*         ENTER HERE TO BUILD THE LOAD PARAMETERS FOR AN OVERLAY.
 
*         (X1) = PLD ENTRY.
*         (X4) = 77777700 ... 00B.
*         (X7) = FIRST CHARACTER OF OVERLAY NAME.
*         (B6) = RETURN ADDRESS.
*
*         NOTE.  (X5) WILL NOT BE CHANGED.
 
 
 SPL1.1   BX1    -X4*X1
          SX3    B1
          SX7    X7-1R7
          LX3    41
          ZR     X7,SPL5     IF *7XX* OVERLAY
 
*         SET *RT* PARAMETER.
 
          BX7    -X3*X1      CLEAR CM/MS BIT
          SB5    -B6         SET (B5) POSITIVE IF CPP
          SX2    214B        SET *RT* PARAMETER POSSIBILITIES
          BX3    X3*X1
          ZR     X3,SPL2     IF MS RESIDENT OVERLAY
          LX1    -24         GET *RPL* ADDRESS
          SB5    A1
          SA1    X1-400000B
          AX2    3           SET NEW *RT* PARAMETER
          BX3    -X4*X1
          SA1    B5          RESTORE THE *PLD* ADDRESS
          AX3    40          ONE = 16-BIT PROGRAM
          SB5    X3
          AX2    B5          SET NEW *RT* PARAMETER
 SPL2     MX3    -4
          BX1    -X4*X1      ENSURE (X1) .GT. 0
          BX2    -X3*X2      *RT* = 14/10/01/00
          LX2    42
          PL     B5,SPL3     IF CONCURRENT PP OR CM RESIDENT
          AX1    23-17
          SX3    X1          SET LEADING ZEROS IF 12-BIT OVERLAY
 SPL3     BX2    X3*X2
          BX7    X7+X2
          TJP    (/CPP/SPL1,CPP,/PROBE/SPL,PROBE,B6)  RETURN
 
 SPL4     SA1    PSTP        READ SFP ENTRY
          SX3    1
          AX1    12
          SA1    X1-2
          LX3    41
 SPL5     IX7    X1+X3       SET *RT* PARAMETER
          BX7    -X3*X7
          TJP    (/CPP/SPL1,CPP,/PROBE/SPL,PROBE,B6)  RETURN
 SPR      SPACE  4,20
**        SPR - SET CPU PRIORITY.
*
*         ENTRY  (B3) = RETURN ADDRESS.
*                (B7) = CONTROL POINT ADDRESS.
*                (X3) = *CWQW*.
*                (X5) = NEW CPU PRIORITY.
*                (A3) = ADDRESS OF *CWQW*.
*
*         EXIT   NEW CPU PRIORITY SET AND CPU SLICE RESTARTED.
*                TO CALLER VIA *RCC* IF JOB IN *W* STATUS.
*                TO CALLER VIA */NVE/SVS* IF JOB ACTIVE IN CPU AND
*                  *NVE* PRESENT.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 6, 7.
*                B - 4, 6.
 
 
 SPR      BSS    0           ENTRY
          SA4    TPRC+X5     GET SERVICE CYCLE FOR NEW PRIORITY
          SA1    B7+STSW     DETERMINE CPU STATUS
          LX5    3
          UX3,B4 X3          UNPACK CPU PRIORITY AND PARAMETERS
          SB4    X5          SET PRIORITY WITHOUT PRIORITY FLAGS
          SX6    B1
          PX3    B4,X3       SET NEW CPU PRIORITY IN *CWQW*
          LX6    47-0
          MX7    6
          BX6    X3+X6       SET EXTENDED CPU SLICE INCOMPLETE FLAG
          BX7    X7*X4
          SA6    A3          UPDATE *CWQW*
          SA7    A3+B1       SET SERVICE CYCLE AND CLEAR ACCUMULATORS
          ERRNZ  CSAW-CWQW-1
          MX4    3
          BX1    X4*X1
          LX1    3
          SX4    X1-WCPS
          ZR     X1,RB3      IF NULL STATUS
          PL     X4,SPR1     IF *W* STATUS OR GREATER
 
*         SET PRIORITY OF ACTIVE JOB.  A CPU SWITCH IS REQUESTED TO
*         FORCE SELECTION OF THE HIGHEST PRIORITY JOB.
 
          SA2    X1+TSCL-1   GET CPU PRIORITY OF ACTIVE JOB
          SA3    X1+CSWL-1
          SB4    B4+3        SET ACTIVE SLICE AND RECALL FLAGS
          UX6    X6
          PX6    B4,X6
          SA6    A6          REWRITE *CWQW* WITH FLAGS
          UX2    X2
          PX6    B4,X2       SET *TSCL* CPU PRIORITY AND FLAGS
          MX7    1
          BX7    X3+X7
          SA7    A3          REQUEST CPU SWITCH
          SA6    A2          UPDATE *TSCL*
          SB6    B3          SET *SVS* RETURN ADDRESS
          MX0    -12
          TJP    (/NVE/SVS1,NVE,/MONITOR/RB3)
 
 SPR1     NZ     X4,RB3      IF NOT *W* STATUS
          SB6    B7+         SET EXCHANGE PACKAGE ADDRESS
          EQ     RCC         REORDER WAIT QUEUE
 SRU      SPACE  4,30
**        SRU - CALCULATE SRU MULTIPLIERS CPM AND IOM.
*
*         SRU = M1(CP + M2*IO + M3(CP+IO)CM +
*                  M4(CP+IO)EC + MM*MP + AUC) + A1
*
*             = M1(1 + M3*CM + M4*EC)CP + M1(M2 + M3*CM + M4*EC)IO +
*                  M1*MM*MP + M1*AUC + A1
*
*             = (M1 + M1*M3*CM + M1*M4*EC)CP +
*                  (M1*M2 + M1*M3*CM + M1*M4*EC)IO +
*                  M1*MM*MP + M1*AUC + A1
*
*             = CPM*CP + IOM*IO + M1M*MP + M1*AUC + A1.
*
*         CP = (S0)*CP0 + (S1)*CP1
*         IO = S2*MS + S3*MT + S4*PF
*         CM = (CM FL + 777B) / 1000B  (WORDS)
*         EC = (ECS FL) / 1000B
*         MP = MAP ACCUMULATOR
*         AUC = AUC ACCUMULATOR
*         A1 = ADDER ACCUMULATOR (MAINTAINED IN MICROUNITS * 10)
*
*         ENTRY  (B4) = EXIT ADDRESS.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                B - 3.
*                A - 1, 3, 4, 6.
*
*         CALLS  CPT
 
 
 SRU      SA3    B7+ECSW     ECS FL
          SA4    B7+FLSW
          MX2    -12
          BX0    -X2*X4
          LX4    12
          BX4    -X2*X4      ADD NEGATIVE FIELD LENGTH
          IX4    X4+X0
          SA1    B7+MP1W     M1*M3 AND M1*M4
          TLX3   0,UESC      ADJUST EM FL
          MX7    -3
          BX3    -X2*X3
          LX1    18
          MX2    -18
          IX4    X4-X7       ROUND CM FL/100B WITH 7B
          BX6    -X2*X1
          AX4    3           CM = (CM FL/100B + 7B) / 10B
          LX1    18
          IX6    X6*X4       M1*M3*CM
          BX7    -X2*X1
          ERRNZ  MP2W-MP1W-1 CODE DEPENDS ON CONTIGUOUS WORDS
          SA4    A1+B1       M1*1000 AND M1*M2
          IX7    X7*X3       M1*M4*EC
          LX4    18
          IX6    X6+X7       M1*M3*CM + M1*M4*EC
          BX3    -X2*X4
          LX4    18
          IX7    X3+X6       M1*1000 + M1*M3*CM + M1*M4*EC (CPM)
          BX4    -X2*X4
          IX4    X4+X6       M1*M2 + M1*M3*CM + M1*M4*EC (IOM)
          LX7    30
          SX6    B4          SAVE EXIT ADDRESS
          SA6    SRUA
          IX4    X7+X4       30/CPM AND 30/IOM
          SB3    SRU1
          TJP    (/NVE/CPT,NVE,/CME/CPT,CME,/MONITOR/CP76,CP176,/MONITOR
,/CPT)
 
 SRU1     SA1    SRUA
          SB4    X1
          SA1    A4+B1
          MX2    1
          BX2    X2*X1
          BX6    X2+X4
          SA6    A1
          JP     B4          EXIT
 
 SRUA     CON    0
 STL      SPACE  4,15
**        STL - SET CPU TIME LIMIT.
*
*         ENTRY  (X3)= TIME LIMIT IN MILLISECONDS.
*                     IF (X3) .LT. 0, TIME LIMIT IS UNLIMITED.
*                (B7)= CONTROL POINT ADDRESS.
*                (B3)= EXIT ADDRESS.
*
*         EXIT   (X7) = 0.
*
*         USES   X - 1, 2, 6, 7.
*                B - 4.
*                A - 2, 6.
*
*         CALLS  MSB.
 
 
 STL      SA2    B7+SRUW     ENTRY
          MX1    1
          BX6    -X1*X3
          LX1    58-59
          BX7    -X1*X2      CLEAR TIME LIMIT
          SA7    A2+
          NG     X3,STL1     IF UNLIMITED REQUEST
          SB4    STL1        SET *MSB* RETURN ADDRESS
          SA2    CPTC        MILLISECONDS TO QUARTER NANOUNITS
          EQ     /PROGRAM/MSB  MULTIPLY 60 BIT INTEGER
 
 STL1     SA6    B7+CPLW
          SX7    B0+         CLEAR OUTPUT REGISTER
          JP     B3          RETURN
 SXR      SPACE  4,10
**        SXR - SET *X* STATUS WITH RECALL CRITERION.
*
*         ENTRY  (X0) = RECALL CRITERION.
*                (B7) = CONTROL POINT ADDRESS.
*
*         EXIT   TO *MTRX* IF CONTROL POINT NOT ACTIVE.
*                TO *BNJ* BEGIN NEW JOB.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 6, 7.
 
 
 SXR      SA1    B7+STSW     GET JOB STATUS
          SA2    RQRL
          SA3    B7+CWQW
          SX6    1
          NG     X1,MTRX     IF *W* OR *I* STATUS
          LX6    46-0
          AX1    57
          BX6    -X6*X3      CLEAR RECALL NOT REQUIRED FLAG
          ZR     X1,MTRX     IF NULL STATUS
          SA6    B7+CWQW     UPDATE *CWQW*
          MX4    -12
          LX0    12
 
*         FIND POSITION IN *RQ*.  CODE IS REPLICATED FOR PERFORMANCE
*         REASONS.
 
 SXR1     BX7    -X4*X2
          SA3    X7
          IX6    X3-X0
          BX5    -X4*X3
          PL     X6,SXR2     IF POSITION REACHED
          SA2    X5
          IX6    X2-X0
          NG     X6,SXR1     IF POSITION NOT REACHED
          BX7    X5
          SA2    A3
 SXR2     SX3    B7+CRCW     ADDRESS OF NEW ENTRY
          BX7    X7+X0
          SA7    X3
          BX2    X4*X2
          BX6    X2+X3
          SX7    XCPS
          SA6    A2
          EQ     BNJ         BEGIN NEW JOB
 SXS      SPACE  4
**        SXS - SET *X* STATUS.
*
*         ENTRY  (B7) = CONTROL POINT ADDRESS.
*
*         EXIT   TO SXR.
 
 
 SXS      SA1    RTCL        GET CURRENT TIME
          SA2    MSCL        EXTRACT RECALL TIME DELAY
          MX0    -36
          BX1    -X0*X1
          MX0    -12
          LX2    -36
          BX2    -X0*X2
          SX0    PTMF        SET RECALL CRITERION
          IX1    X1+X2
          LX0    36
          BX0    X0+X1
          EQ     SXR         SET *X* STATUS WITH RECALL CRITERION
 TSM      SPACE  4,15
**        TSM - TERMINATE STORAGE MOVE.
*
*         EXIT   (SMRL) = 0.
*         TO *BNJ1* (VIA *UMT* AND *JAV*).
*         TO *CRA5* IF FIELD LENGTH SWAP.
*
*         USES   X - 0, 1, 2, 4, 5, 6.
*                A - 1, 4, 6.
*                B - 3, 6.
*
*         CALLS  BNJ, JAV, RCC, SCA.
 
 
 TSM      SA1    SMPXP+STSW  CLEAR CPU STATUS ON PSEUDO-CP
          MX2    -57
          BX6    -X2*X1      SET NULL STATUS
          SA6    A1+
          SB3    TSM1
          EQ     SCA         CONVERT CP/PCP ADDRESS
 
 TSM1     SA4    A2          READ *SMRL*
          LX4    59-37
          TNG    X4,(/ECS/TSM4,EEC,/MONITOR/TSM2)  IF ECS ERROR ON MOVE
 TSM2     LX4    37-36
          ERRNZ  ICPS-6      CODE DEPENDS ON VALUE
          MX5    2
          TNG    X4,(/ECS/TSM8,EEC,/MONITOR/TSM3)  IF USER ECS ERROR
 TSM3     LX4    59-47+36-59
          SB3    TSM4        *RCC* RETURN ADDRESS
          AX4    57
          ZR     X4,TSM4     IF STATUS PREVIOUS NULL
          SX4    X4+1
          SB6    B7+         EXCHANGE PACKAGE ADDRESS
          NZ     X4,RCC      IF PREVIOUSLY ACTIVE STATUS
          SA1    B7+STSW
          BX6    X1+X5       SET *I* STATUS
          SA6    A1
 
*         CPU STATUS IS RESTORED BEFORE *SMRL* IS CLEARED SO THAT ANY
*         PP PROGRAMS SENSING CPU STATUS WILL NOT MISS IT.
 
 TSM4     SA2    TSMA        CHECK BLOCK MOVE STATUS
          SB4    BNJ1
          NZ     X2,TSM6     IF FIELD LENGTH SWAP
          TB5    SCA
          GT     B7,B5,TSM5  IF PSEUDO-CONTROL POINT
          SB4    JAV         SET *UMT* EXIT ADDRESS
 TSM5     SB3    BNJ1        SET *JAV* EXIT ADDRESS
          EQ     UMT         UPDATE MEMORY CONTROL TABLE
 
 TSM6     SA1    SMRL        GET MOVE PARAMETERS
          BX0    X2
          SX4    X1          EXTRACT MEMORY TYPE FLAG
          AX4    12-1
          MX5    -12
          ERRNZ  FLSW+2-ECSW  CODE DEPENDS ON VALUE
          SX6    X4+FLSW
          SA1    X6+B7       READ FL CONTROL WORD
          SX2    B7
          BX5    -X5*X1      EXTRACT FIELD LENGTH
          AX4    1
          AX2    7-1
          TB5    X4,MCT      SET BASE MCT ADDRESS
          AX1    48
          SA4    X2+B5       READ REQUESTOR-S MCT ENTRY
          IX1    X1+X5
          LX0    1           CONVERT MCT ORDINAL TO INDEX
          IX7    X4+X1       ADJUST REQUESTOR-S HOLE SIZE
          SA4    TSMB        GET PRE-MOVE HOLE POINT HOLE SIZE
          SA3    X0+B5       READ HOLE POINT MCT ENTRY
          MX5    12
          IX6    X3-X4       ADJUST HOLE POINT HOLE SIZE
          SA7    X2+B5
          IX4    X4-X1
          AX2    1
          MX7    -24
          BX3    X7*X3
          LX5    -12
          BX3    X3+X4
          EQ     CRA5        CHANGE MEMORY TABLE LINKAGE
 
 
 TSMA     CON    0           HOLE POINT NUMBER IF BLOCK MOVE
 TSMB     CON    0           PRE-MOVE HOLE POINT HOLE SIZE
          TITLE  CPU REQUEST PROCESSOR.
 CPR      SPACE  4
***       CPU PROGRAM REQUESTS.
*
*
*                CPU PROGRAM REQUESTS ARE PASSED THROUGH RELATIVE
*         LOCATION 1.  THE FORMAT IS AS FOLLOWS -
*
*T        18/  NAME,6/  A,36/  ARG
*
*         NAME   REQUEST NAME
*         A      20B IF AUTO RECALL DESIRED
*         ARG    ARGUMENTS
*
*
*                IF THE REQUEST IS NOT ONE OF THE FOLLOWING, AND THE
*         NAME OF THE REQUEST BEGINS WITH AN ALPHA CHARACTER,
*         THE REQUEST IS ASSUMED TO BE THE NAME OF A PP PROGRAM, AND
*         THIS PROGRAM IS ASSIGNED TO AN AVAILABLE PP.
*
*                IF THE REQUEST IS NOT OF THE ABOVE FORMAT, THE JOB IS
*         ABORTED WITH A *MONITOR CALL ERROR.*.
 CPR      SPACE  4
**        CPR - PROCESS CPU REQUEST.
*
*         ENTRY  (X2) = RA.
*                (X5) = (RA+1).
*                (A2) = ADDRESS OF RA IN EXCHANGE PACKAGE.
*                (B3) = ADDRESS OF WORD IN CPUMTR CONTAINING RA.
*                (B7) = CONTROL POINT ADDRESS.
 
 
 CPR      SA1    A2+B1       GET FL
          BX4    X5
          MX0    -12
          LX4    18
          AX1    36
          SX7    X4-3RRCL
          SB4    X1          SET FL
          NZ     X7,CPR2     IF NOT *RCL*
 
*         PROCESS *RCL* IN LINE DUE TO FREQUENCY OF USE.
 
          LX4    59-40-18
          SX3    B1
          IX2    X2+X3       RA+1
          NG     X4,CPR1     IF AUTO RECALL
          EWX7   X2          CLEAR RA+1
          EQ     SXS         SET *X* STATUS
 
 CPR1     SX3    X5-1        RECALL ADDRESS - 1
          SA1    B7+STSW     CHECK ACTIVITY
          MX6    -4
          SB5    X5
          LX6    4
          IX4    X2+X3       ADDRESS OF WORD RECALLED ON
          BX7    -X6*X1
          LX6    48-4
          GE     B5,B4,CPE   IF ILLEGAL ADDRESS
          LE     B5,B1,CPE   IF ILLEGAL ADDRESS
          BX6    -X6*X1
          ERX1   X4          CHECK WORD RECALLED ON
          BX7    X7+X6
          MX6    -18
          R=     X0,PCBF     PROCESS COMPLETION BIT
          LX0    36
          LX1    59-0
          BX0    X0+X4
          SA4    B7+SSCW     CHECK FOR SUBSYSTEM CONNECTIONS
          ZR     X7,CPR1.2   IF NO ACTIVITY
          PL     X1,SXR      IF BUSY, SET *X* STATUS, RECALL CONDITION
 CPR1.1   BX7    X7-X7
          EWX7   X2          CLEAR RA+1
          EQ     MTRX        RETURN
 
 CPR1.2   NG     X1,CPR1.1   IF COMPLETION BIT SET
          SA1    B7+DBAW     GET K-DISPLAY BUFFER ADDRESSES
          SA2    B7+JCIW     CHECK SUBSYSTEM ID
          MX3    -12
          BX7    -X6*X5
          LX3    24
          BX3    -X3*X2
          NZ     X3,SXR      IF SUBSYSTEM
          NZ     X4,SXS      IF SUBSYSTEM CONNECTIONS
          BX3    -X6*X1      CHECK K-DISPLAY BUFFERS
          LX6    18
          BX6    -X6*X1
          LX1    59-58
          BX3    X3-X7
          LX6    -18
          BX6    X6-X7
          SX7    RCET
          NG     X1,SEF      IF K-DISPLAY STATUS NOT TO BE RETURNED
          ZR     X3,SXR      IF K-DISPLAY ADDRESS MATCHES
          ZR     X6,SXR      IF K-DISPLAY ADDRESS MATCHES
          EQ     SEF         SET ERROR FLAG
 
 CPR2     SX6    X4-3RTIM
          SA3    CMCL        CHECK STORAGE MOVE REQUEST
          ZR     X6,TIM      IF *TIM*
          SX7    B7
          AX3    48
          AX7    7
          BX7    X7-X3
          SA3    B7+STSW     CHECK SUBCP ACTIVE
          ZR     X7,SXS      IF STORAGE MOVE REQUESTED
          LX3    59-56
          BX7    -X0*X4
 CPR3     TNG    X3,(/MONITOR/BCE,SUBCP,/MONITOR/CPR3)
          SB5    X4-3RMSG
          ZR     X7,CPE      IF LAST TWO CHARACTERS OF PP CALL ZERO
          SX7    B1+
          LX7    41-0
          BX5    -X7*X5      CLEAR BIT 41 IN RA+1 CALL
 
 
*         IDENTIFY REQUEST BY TREE SEARCH.
*         EXIT TO PROCESSOR WITH
*         (X0) = -7777B
*         (X1) = FL
*         (X2) = RA
*         (X4) = REQUEST WORD SHIFTED 18
*         (X5) = REQUEST WORD
*         (B3) = ADDRESS OF MEMORY WORD CONTAINING RA.
*         (B4) = FL
*         (B7) = CONTROL POINT ADDRESS
 
          ZR     B5,MSG      IF *MSG*
          SX7    X4-3RCIO
          PL     B5,CPR5     IF ABOVE *MSG*
          ZR     X7,CIO      IF *CIO*
          PL     X7,CPR4     IF ABOVE *CIO*
          SB6    X4-3RABT
          ZR     B6,ABT      IF *ABT*
          SX6    X4-3RAAA
          PL     X6,APJ      IF LEGAL PROGRAM NAME
          EQ     CPE         *MONITOR CALL ERROR.*
 
 
 CPR4     SX6    X4-3RLDR
          ZR     X6,LDR      IF *LDR*
          SX7    X4-3RCPM
          PL     X6,LDV      IF ABOVE *LDR*
          SX6    X4-3REND
          ZR     X7,CPM      IF *CPM*
          SX7    X4-3REJT
          ZR     X6,END      IF *END*
          ZR     X7,EJT      IF *EJT*
          SX7    X4-3RCLO
          NZ     X7,APJ      IF NOT *CLO*
          EQ     CLO         CONVERT *CLO* TO *CIO*
 
 
 CPR5     SX7    X4-3RRFL
          PL     X6,CPR6     IF ABOVE *TIM*
          NG     X7,PFL      IF BELOW *RFL*
          SX6    X4-3RRSB
          ZR     X7,RFL      IF *RFL*
          ZR     X6,RSB      IF *RSB*
          SX7    X4-3RSPC
          ZR     X7,SPC      IF *SPC*
          PL     X6,SIC      IF ABOVE *RSB*
          SX6    X4-3RRPV
          ZR     X6,RPV      IF *RPV*
          EQ     APJ
 
 
 CPR6     SX7    X4-3RWCL
          SX6    X4-3RXJP
          ZR     X7,WCL      IF *WCL*
          SX7    X4-3RXJR
          TZR    X6,(/MONITOR/XJP,SUBCP,/MONITOR/APJ)  IF *XJP*
          ZR     X7,XJR      IF *XJR*
          SX6    X4-3R0AA
          PL     X6,CPE      IF ILLEGAL REQUEST
          EQ     APJ         ASSIGN PPU JOB
 AAR      SPACE  4,10
**        AAR - ASSIGN AUTO RECALL PP REQUEST.
*
*         ENTRY  (X5) = PP REQUEST.
*                (B7) = CONTROL POINT.
 
 
 AAR      SB4    B0+         SET LIBRARY SEARCH NEEDED
 AAR1     SB6    AAR2        *CAL* RETURN ADDRESS - NO LIMIT
          SB3    SXS         *CAL* RETURN ADDRESS - ACTIVITY LIMIT
          EQ     CAL         CHECK ACTIVITY LIMIT
 
 AAR2     MX0    1           FORCE AUTO-RECALL
          SX7    B0+         CLEAR RA+1
          LX0    41-59
          SA2    RA1         ADDRESS OF RA+1
          EWX7   X2          CLEAR (RA+1)
          BX6    X0+X5
          SA7    APQA
          SB3    SIS         *APQ* RETURN ADDRESS
          EQ     APQ         ASSIGN PP
 APJ      SPACE  4,15
**        APJ - ASSIGN PPU JOB.
*
*         ENTRY  (X5) = PPU REQUEST WORD.
*                (B7) = CONTROL POINT ADDRESS.
*
*         EXIT   TO *APQ* TO ASSIGN PP.
*                TO *SXS* TO SET X STATUS IF ACTIVITY LIMIT.
*
*         USES   X - ALL.
*                B - 3, 4, 6.
*                A - 1, 2, 7.
*
*         CALLS  CAL.
 
 
 APJ      BX7    X7-X7       CLEAR PP PARAMETER WORD
          SB4    B0          SET LIBRARY SEARCH NEEDED
          SA7    APQA
 APJ0     SA1    B7+JCIW     CHECK FOR SUBSYSTEM OR NON-ROLLABLE JOB
          SX3    B1
          LX1    0-21
          BX4    X3*X1       *DIS* FLAG
          LX3    40-0
          BX6    X3*X5       CHECK FOR AUTO RECALL
          LX1    -24-0+21
          MX2    -12
          BX2    -X2*X1      SUBSYSTEM IDENTIFICATION
          NZ     X6,APJ0.1   IF PP CALL WITH AUTO RECALL
          BX6    X2+X4
          NZ     X6,APJ2     IF SYSTEM JOB
          BX5    X5+X3       FORCE AUTO RECALL
 APJ0.1   SA1    B7+STSW     GET JOB ACTIVITY
          MX6    -8
          SX2    X2-LSSI-1
          LX1    -4
          BX6    -X6*X1      RECALL/TAPE ACTIVITY COUNT
          PL     X2,APJ0.2   IF SUBSYSTEM
          LX1    12+4
          MX2    -5
          BX2    -X2*X1      PP COUNT
          IX6    X6+X2
          IX6    X6-X4       ALLOW FOR *DIS*
 APJ0.2   NZ     X6,SXS      IF PP OR TAPE ACTIVITY
 
*         ASSIGN PPU JOB.
 
 APJ1     MX0    1           EXTRACT AUTO RECALL FLAG
          LX0    40-59
          BX0    X0*X5
          LX0    41-40
          SA2    RA1         ADDRESS OF RA+1
          SX7    B0+         CLEAR RA+1
          BX6    X0+X5       MAP AUTO RECALL TO BIT 41
          EWX7   X2          CLEAR (RA+1)
          SB3    SIS         *APQ* RETURN ADDRESS
          TNZ    X0,(/DCP/APQ,DCPC,/MONITOR/APQ)  IF AUTO-RECALL
          SB3    MTRX
          TJP    (/DCP/APQ,DCPC,/MONITOR/APQ)  ASSIGN PP
 
*         AVOID FORCED AUTO RECALL
 
 APJ2     SB6    APJ1        *CAL* RETURN ADDRESS - NO LIMIT
          SB3    SXS         *CAL* RETURN ADDRESS - ACTIVITY LIMIT
          EQ     CAL         CHECK ACTIVITY LIMIT
 AFL      SPACE  4,20
**        AFL - ASSIGN FIELD LENGTH.
*
*         ENTRY  (X1) = CURRENT FIELD LENGTH.
*                (X2) = REQUESTED FIELD LENGTH.
*                (X5) = *1MA* CALL TO BE ISSUED IF NEEDED.
*                (B3) = ADDRESS OF MEMORY WORD CONTAINING RA.
*                (B5) = STATUS RESPONSE ADDRESS.
*                (B7) = CONTROL POINT ADDRESS.
*                (A5) = RA+1.
*
*         EXIT   TO MTRX.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 2, 3, 4, 6, 7.
*                B - 4, 5, 6.
*
*         CALLS  APJ, SFL.
 
 
 AFL      SA3    B7+ECSW     GET ECS CONTROL WORD
          MX7    -17         SET FIELD LENGTH
          BX0    -X7*X2
          MX4    -12         GET ECS FIELD LENGTH
          SB6    B2          SET EXCHANGE PACKAGE ADDRESS
          BX4    -X4*X3
          BX6    X1          RETAIN CURRENT FL
          ZR     X0,AFL3     IF EMPTY REQUEST
          SX3    X0-MCMX
          ZR     X4,AFL1     IF NO ECS ASSIGNED
          PL     X3,AFL1     IF FL .GE. MCMX
          SX0    MCMX        SET FL TO MINIMUM ALLOWED WITH ECS
 
*         CHECK DIRECTION OF REQUEST.
 
 AFL1     SX1    X0+77B      ROUND UP REQUEST
          NG     X1,CPE      IF REQUEST TOO LARGE
          AX1    6
          LX1    6
          IX0    X1-X6       CHECK REQUEST
          LX2    59-17
          ZR     X0,AFL3     IF NO MEMORY CHANGE
          SB4    LA1MA       SET *1MA* LOAD PARAMETER INDEX
          PL     X0,APJ1     IF MEMORY INCREASE CALL *1MA*
 
*         CHECK NO-REDUCE STATUS.
 
          SA4    B7+STSW     CHECK ACTIVITY
          SA3    AM
          BX4    X3*X4
          MX7    -12
          ZR     X4,AFL2     IF NO PP ACTIVITY
          SA4    B7+JCIW     CHECK FOR SUBSYSTEM OR NON-ROLLABLE JOB
          LX4    -24
          BX7    -X7*X4
          LX4    0-21+24     CHECK FOR *DIS* JOB
          SX3    B1
          BX4    X3*X4
          BX4    X4+X7
          ZR     X4,SXS      IF NOT SYSTEM JOB
 AFL2     SA3    B7+LB1W     READ LOADER CONTROL
          LX3    59-53
          BX4    -X3+X2
          TX7    B7+200B,-SCA CHECK CONTROL POINT
          AX4    60
          BX0    X4*X0
          PL     X4,AFL3     IF NO CHANGE IN MEMORY
          BX6    X1          SET NEW FIELD LENGTH
          ZR     X7,APJ1     IF LAST CONTROL POINT CALL *1MA*
          SA3    SSTL
          LX3    59-58
          PL     X3,APJ1     IF MEMORY CLEARING ENABLED
 AFL3     BX7    X7-X7       CLEAR (RA+1)
          SA3    B3+B1
          EWX7   X3
          ZR     B5,SFL      SET FIELD LENGTH IF NO STATUS RESPONSE
          SX4    B5
          SA3    B3
          IX4    X4+X3
          ERX3   X4          CHECK FOR CMM CLEAR JOB STEP STATUS
          LX6    30
          SX7    B1
          LX3    59-3
          BX6    X6+X7       STORE STATUS RESPONSE
          SB5    B0
          EWX6   X4
          PL     X3,SFL      IF NOT CMM CLEAR
          SA3    B7+DBAW
          LX7    54
          BX6    -X7*X3
          SA6    A3
          EQ     SFL         SET FIELD LENGTH
 CIO      SPACE  4
**        CIO - CALL CIO.
*
*         ENTRY  (X7) = 0.
 
 
 CIO      SB6    CIO1        *CAL* RETURN ADDRESS - NO LIMIT
          SB3    SXS         *CAL* RETURN ADDRESS - ACTIVITY LIMIT
          EQ     CAL         CHECK ACTIVITY LIMIT
 
 CIO1     SA7    /CPUCIO/MB
          SX0    B1          MOVE AUTO RECALL BIT FROM BIT 40 TO 41
          LX0    40
          SA2    RA1         ADDRESS OF (RA+1)
          BX0    X0*X5       EXTRACT AUTO RECALL BIT
          BX5    -X0*X5
          LX0    41-40
          SB3    A2-B1       RESET ADDRESS OF WORD CONTAINING RA
          BX6    X0+X5
          SA6    A7-B1       STORE REQUEST WORD
          ERRNZ  /CPUCIO/IR-/CPUCIO/MB+1  CODE REQUIRES CONTIGUOUS
          EWX7   X2          CLEAR (RA+1)
          TEQ    (/PROBE/CIO,PROBE,/CPUCIO/CPC)
 CLO      SPACE  4,10
**        CLO - CLOSE.  (CONVERT CALL TO *CIO*)
*
*         ENTRY  (X7) = 0.
 
 
 CLO      MX2    42
          SX3    3RCIO
          BX4    X2*X4
          BX5    X4+X3
          LX5    42
          EQ     CIO         PROCESS AS *CIO* REQUEST
 CPE      SPACE  4
**        CPE - PROCESS CPU CALL ERROR.
 
 
 CPE      SX7    PCET        SET ERROR FLAG = *MONITOR CALL ERROR.*
          EQ     SEF
 ABT      SPACE  4
***       *ABT*.
*         ABORT JOB.
*
*T        18/  *ABT*,42/
 
 
 ABT      SX7    CPET        SET CPU ABORT FLAG
          JP     SEF
 CPM      SPACE  4
***       *CPM*.
*         RESIDENT CPM FUNCTIONS.
*
*         ENTRY  (X7) = 0.
*
*T        18/  *CPM*,6/,12/  FN,6/,18/  PAR
*         FN     FUNCTION NUMBER.
*         PAR    PARAMETER.
 
 
 CPM      SA2    CPMA        READ VALID FUNCTION WORD
          LX4    -24-18      EXTRACT FUNCTION
          SX3    X5
          BX4    -X0*X4
          SB4    X4
          IX4    X3-X1       CHECK PARAMETER PAST FL
          AX2    X2,B4
          CX6    X2
          LX6    X6,B1       INDEX * 2
          LX2    59
          SB4    X6
          BX4    X2*X4
          SB5    -B4
          BX6    -X4+X3
          SA2    B3          ADDRESS OF RA
          SB4    LACPM       SET *CPM* LOAD PARAMETER INDEX
          NG     X6,APJ0     IF BAD PARAMETER OR NON-CPUMTR FUNCTION
          IX3    X2+X3       ABSOLUTE PARAMETER ADDRESS
          SA2    B3+B1
          EWX7   X2          CLEAR RA+1
          MX2    -18
          JP     CPMB+B5     JUMP TO PROCESSOR
 
*         EXIT TO PROCESSOR WITH -
*                (X0) = -7777B.
*                (X1) = FL.
*                (X2) = -777777B.
*                (X3) = PARAMETER ADDRESS.
*                (X7) = 0.
*                (B3) = ADDRESS OF MEMORY WORD CONTAINING RA.
*                (B7) = CONTROL POINT ADDRESS.
 
*         NOTE - FUNCTIONS 73B AND ABOVE MUST BE PROCESSED BY THE PPU
*         CPM PROCESSOR.
*
*         SET BIT INDICATES VALID CENTRAL FUNCTION.
*         THESE FUNCTIONS MUST BE IN REVERSE ORDER.
 
 CPMA     BSS    0
          POS    65B+1
          VFD    1/1
          POS    64B+1
          VFD    1/1
          POS    63B+1
          VFD    1/1
          POS    62B+1
          VFD    1/1
          POS    61B+1
          VFD    1/1
          POS    55B+1
          VFD    1/1
          POS    51B+1
          VFD    1/1
          POS    50B+1
          VFD    1/1
          POS    45B+1
          VFD    1/1
          POS    43B+1
          VFD    1/1
          POS    37B+1
          VFD    1/1
          POS    33B+1
          VFD    1/1
          POS    32B+1
          VFD    1/1
          POS    25B+1
          VFD    1/1
          POS    24B+1
          VFD    1/1
          POS    16B+1
          VFD    1/1
          BSS    0           FORCE UPPER
 
*         EACH FUNCTION MUST OCCUPY TWO WORDS OF CODE AND MUST BE IN
*         ORDER OF OCCURENCE.
 
*         FUNCTION 16.
 
 +        SA1    B7+3        READ EXIT MODE
          LX1    12
          BX6    -X0*X1
          EWX6   X3
          JP     MTRX        EXIT
 
*         FUNCTION 24.
 
 +        SA1    B7+JCRW     READ JOB CONTROL WORD
          BX6    X1
          EWX6   X3
          JP     MTRX        EXIT
 
*         FUNCTION 25.
 
          ERX1   X3
          BX6    X1
          SA6    B7+JCRW
          JP     MTRX        EXIT
 
*         FUNCTION 32.
 
 +        SA1    B7+UIDW     RETURN USER NUMBER
          BX6    X2*X1
          EWX6   X3
          JP     MTRX        EXIT
 
*         FUNCTION 33.
 
 +        SA1    B7+FLCW     READ FIELD LENGTH CONTROL WORD
          BX6    X1
          EWX6   X3
          JP     MTRX        EXIT
 
*         FUNCTION 37.
 
 +        SA1    B7+TXSW     READ TELEX SUB-SYSTEM
          MX6    -6
          LX1    6
          BX6    -X6*X1
          EWX6   X3
          JP     MTRX
 
*         FUNCTION 43.
 
 +        SA1    B7+SEPW     READ SPECIAL ENTRY POINT WORD
          SX2    B1
          SB6    X1
          ZR     B6,CPM1     IF NO PARAMETER BLOCK
          EQ     CPM4        RESTORE (RA+1)
 
*         FUNCTION 45.
 
 +        SA1    B7+LB1W     READ FIRST LOADER CONTROL WORD
          BX6    X1
          EWX6   X3
          JP     MTRX        EXIT
 
*         FUNCTION 50.
 
 +        SA1    MMFL        READ MACHINE ID WORD
          LX1    12
          BX6    -X0*X1
          EWX6   X3
          JP     MTRX        EXIT
 
*         FUNCTION 51.
 
+         SX3    B1          FORCE AUTO RECALL
          BX7    X5          RESET RA+1 REQUEST
          SA2    RA1
          LX3    40
          EWX7   X2
          EQ     CPM1.3      EXIT
 
*         FUNCTION 55.
 
+         SA1    B7+ELCW     READ ECS FL CONTROL WORD
          TLX1   0,UESC
          BX6    X1
          EWX6   X3
          JP     MTRX        EXIT
 
*         FUNCTION 61.
 
 +        SA4    B7+LOFW     READ LIST POINTER
          LX2    24          POSITION MASK
          SX7    B1
          BX4    -X2*X4
          EQ     CPM3        SET COMPLETE BIT
 
*         FUNCTION 62.
 
          ERX4   X3
          LX4    -30
          BX4    -X2*X4
          IX1    X4-X1       CHECK LIST BASE ADDRESS WITHIN FL
          NG     X1,CPM2     IF LIST WITHIN FL
          EQ     CPM4        ASSIGN PPU
 
*         FUNCTION 63.
 
          SA4    B7+EOJW     READ END-OF-JOB CONTROL WORD
          MX6    -6
          LX4    6           RETURN TERMINATION STATUS
          BX6    -X6*X4
          EQ     CPM3.1      CONTINUE
 
*         FUNCTION 64.
 
          SA4    B7+SEPW     CHECK SSJ=
          SA2    B7+JCIW     CHECK FOR SUBSYSTEM
          LX4    59-50
          AX2    -24
          EQ     CPM3.2      CONTINUE
 
*         FUNCTION 65.
 
 +        SA1    B7+SEPW
          LX1    59-50
          PL     X1,CPM4     IF NOT SSJ=
          EQ     CPM3.5      SET/CLEAR UTL= ENTRY POINT
 
 CPMB     BSS    0
 
*         EXIT FOR FUNCTION 43.
 
 CPM1     LX2    50-0        BIT MASK
          SB6    X5
          SB6    B6-1
          GT     B6,CPM1.1   IF DISABLE/ENABLE SSJ=
          BX6    -X2*X1      CLEAR SSJ=
          LX2    55-50
          BX6    -X2*X6      CLEAR LDR=
          LX2    36-55
          BX6    -X2*X6      CLEAR ENABLE SSJ=
          SA6    A1
          NG     B6,MTRX     IF ZERO PARAMETER
          LX1    59-48
          LX2    59-36
          NG     X1,MTRX     IF SSM= ENTRY POINT
          SA1    B7+DBAW
          BX6    -X2*X1
          SA6    A1
          JP     MTRX        EXIT
 
 CPM1.1   SB6    B6-B1
          GT     B6,CPM1.2   IF ENABLE SSJ=
          BX6    X2*X1       EXTRACT SSJ=
          BX1    -X2*X1      CLEAR SSJ=
          LX2    55-50
          BX1    -X2*X1      CLEAR LDR=
          LX2    36-55
          BX1    -X2*X1      CLEAR ENABLE SSJ=
          LX6    36-50
          BX6    X6+X1       SET ENABLE SSJ=
          SA6    A1
          JP     MTRX        EXIT
 
 CPM1.2   SB6    B6-1
          GT     B6,CPM4     IF INCORRECT REQUEST
          BX6    X1
          LX6    59-36
          PL     X6,CPM4     IF INCORRECT REQUEST
          BX6    X2+X1       SET SSJ=
          LX2    36-50
          BX6    -X2*X6      CLEAR ENABLE SSJ=
          SA6    A1
          JP     MTRX        EXIT
 
*         EXIT FOR FUNCTION 51.
 
 CPM1.3   BX5    X5+X3
          EQ     APJ1        ASSIGN PPU
 
*         EXIT FOR FUNCTIONS 61 AND 62.
 
 CPM2     LX2    24          POSITION MASK
          SA1    B7+LOFW     READ LIST POINTER
          LX4    24
          BX1    X2*X1       CLEAR OLD LIST ADDRESS
          SX7    B1
          BX6    X1+X4
          SA6    A1
 CPM3     LX4    6           RE-POSITION LIST ADDRESS
          BX7    X4+X7       SET COMPLETE BIT
          EWX7   X3
          EQ     MTRX        EXIT
 
*         EXIT FOR FUNCTION 63.
 
 CPM3.1   SA4    B7+TFSW
          LX4    12
          BX4    -X0*X4      EJT ORDINAL
          CX1    X4,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA4    X1+SCHE,EJT READ EJT WORD
          SX7    300B
          LX4    6-33
          BX4    X7*X4       JOB TERMINATION STATUS
          BX6    X4+X6       ADD TO REPLY
          EWX6   X3
          JP     MTRX        EXIT
 
*         EXIT FOR FUNCTION 64.
 
 CPM3.2   NG     X4,CPM3.3   IF SSJ=
          BX2    -X0*X2
          SX2    X2-LSSI
          NG     X2,CPM4     IF NOT SUBSYSTEM
 CPM3.3   BX2    X3          CHECK PARAMETER BLOCK WITHIN FL
          SX4    4           PARAMETER BLOCK LENGTH
          IX3    X3+X4
          SA4    B3          GET RA ADDRESS
          IX4    X1+X4
          IX4    X4-X3
          SX1    B1
          NG     X4,CPM4     IF PARAMETER BLOCK PAST FL
          SB3    CPM3.4      SET EXIT ADDRESS
          BX5    X2          SAVE PARAMETER BLOCK ADDRESS
          IX2    X2+X1       SKIP STATUS WORD
          EQ     IAA         INCREMENT AUC ACCUMULATOR
 
 CPM3.4   SX6    B5          SET ERROR CODE
          LX6    9
          EWX6   X5
          EQ     MTRX        EXIT
 
*         EXIT FOR FUNCTION 65.
 
 CPM3.5   BX2    -X2*X5      GET SET/CLEAR FLAG
          MX3    1
          LX2    5-0
          LX3    5-59
          BX1    -X3*X1      CLEAR OLD UTL= VALUE
          BX6    X1+X2       MERGE NEW UTL= VALUE
          LX6    50-59       RE-POSITION *SEPW*
          SA6    A1          UPDATE *SEPW*
          EQ     MTRX        EXIT
 
 
*         RESTORE (RA+1).
 
 CPM4     BX7    X5
          SA1    B3+B1       GET RA+1 ADDRESS
          EWX7   X1
          JP     APJ0        ASSIGN PPU
 EJT      SPACE  4,10
***       *EJT*.
*         EXECUTING JOB TABLE UPDATE FUNCTIONS.
*
*         EXIT   JOB ENABLED, OR *1MA* CALL MADE.
*
*         ERROR  TO *CPE* IF ABORT REQUIRED.
*                ERROR CODE RETURNED TO CALLER IF NO ABORT REQUIRED.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 4, 6.
*
*         CALLS  SCD.
*
*T RA+1   18/*EJT*,6/AR,18/0,18/ADDR
*         ADDR = RELATIVE ADDRESS OF PARAMETER BLOCK.
*
*ADDR     24/ JSN,12/ FLAGS,6/ PPI,8/ ERR,9/ FCN,1/C
*         42/ NAME,6/ ERF,12/ EJTO
*         3/RES,3/JAL,6/ OT,6/ RC,18/ MSG BUF,24/ RES
*         60/ REC WD 1
*         60/ REC WD 2
*         12/ INST,12/ TN,36/ CDC RES
*         42/ TNAME, 18/ RESERVED
*
*         JSN = JOB SEQUENCE NUMBER.
*         FLAGS = DTEJ, RCEJ - BIT 0 = CHANGE SERVICE CLASS.
*                 ENEJ - BIT 0 - TERMINAL CONTROL DISABLED.
*                 RTEJ - BIT 0 = SELECT EJT ENTRIES BY ORIGIN TYPE.
*                        BIT 1 = DEFAULT TIMEOUT (CLEAR = 0 TIMEOUT).
*         PPI = PREPROCESSOR INDEX.
*         ERR = ERROR RETURN (0 ON CALL).
*         FCN = FUNCTION CODE.
*         C = COMPLETE BIT (0 ON CALL).
*         NAME = ENEJ - ENTRY POINT NAME.
*                DTEJ, RCEJ, RSEJ - USER NAME.
*         ERF = ERROR FLAG TO SET.
*         EJTO = EXECUTING JOB TABLE ORDINAL.
*         RES = RESERVED FOR CDC.
*         JAL = JOB ACCESS LEVEL LIMIT (RETURNED ON *DTEJ*; 0 ON CALL).
*         OT = ORIGIN TYPE.
*         RC = REASON CODE.
*         MSG BUF = RELATIVE ADDRESS OF BUFFER TO RETURN *MS1W*.
*         REC WD 1 = RECOVERY WORD 1 (NFL WORD RC1N - SEE *PPCOM*).
*         REC WD 2 = RECOVERY WORD 2 (NFL WORD RC2N - SEE *PPCOM*).
*         INST = RESERVED FOR INSTALLATIONS.
*         TN = TERMINAL NUMBER.
*         CDC RES = RESERVED FOR CDC.
*         TNAME = TERMINAL NAME (RETURNED BY *DTEJ* AND *TJEJ*;
*                                SPECIFIED ON CALL FOR *RCEJ*).
*
*         NOTE - ANY CHANGES TO THIS PARAMETER BLOCK SHOULD ALSO
*                BE DOCUMENTED IN *IAFEX* AND *1MA*.
 
 
 EJT      BSS    0           ENTRY
          SA3    B7+JCIW     CHECK SUBSYSTEM IDENTIFICATION
          AX3    24
          BX3    -X0*X3
          ZR     X3,CPE      IF NOT SUBSYSTEM
          SB6    X5          VALIDATE PARAMETER BLOCK ADDRESS
          LE     B6,B1,CPE   IF ADDRESS INVALID
          SX3    B6+EJPB
          IX4    X1-X3
          NG     X4,CPE      IF BEYOND FL
          SX3    B6
          IX6    X2+X3
          SX3    B1
          SA6    T1          SAVE PARAMETER BLOCK FWA
          ERX4   X6          GET FIRST WORD OF PARAMETER BLOCK
          IX6    X6+X3
          SA6    A6+B1
          ERRNZ  T2-T1-1     ADDRESSES MUST BE CONSECUTIVE
          MX6    -10         EXTRACT FUNCTION CODE
          BX6    -X6*X4
          LX6    59-0
          NG     X6,CPE      IF COMPLETE BIT ALREADY SET
          SX7    X6-MXEJ
          PL     X7,CPE      IF INVALID REQUEST CODE
          ZR     X6,CPE      IF INVALID REQUEST CODE
          SX7    X6-RCEJ
          ZR     X7,EJT1     IF RECOVERY REQUEST
 
*         VALIDATE EJT ORDINAL AND JSN.
 
          R=     X2,IEER     ILLEGAL EJT ORDINAL ERROR CODE
          SA1    A6          READ SECOND WORD OF PARAMETER BLOCK
          ERX1   X1
          TX7    EJTM        MAXIMUM EJT ORDINAL
          BX1    -X0*X1      REQUEST EJTO
          IX7    X7-X1
          NG     X7,EJT7     IF EJTO OUT OF RANGE
          MX0    24
          BX7    X0*X4       REQUEST JSN
          SX3    X6-RTEJ
          BX7    X7+X1
          NZ     X3,EJT0.1   IF NOT *RTEJ*
          ZR     X7,EJT1     IF *RTEJ* BY ORIGIN TYPE
 EJT0.1   ZR     X1,EJT7     IF EJT ORDINAL = 0
          BX7    X0*X7       ISOLATE REQUEST JSN
          CX3    X1,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA3    X3+JSNE,EJT
          BX0    X0*X3       JSN FROM ENTRY
          BX1    X0-X7       COMPARE JSN-S
          ZR     X0,EJT7     IF FREE EJT ENTRY
          R=     X2,JFER     JOB NOT FOUND ERROR CODE
          NZ     X1,EJT7     IF JSN MISMATCH
          R=     X2,RTER     RETRY ERROR CODE
          SX7    X6-SAEJ
          ZR     X7,EJT1     IF SET ABORT REQUEST
 
*         CHECK INTERLOCK AND JOB ADVANCE.
 
          SX1    B1
          BX0    X1*X3
          BX7    X1+X3       SET ENTRY INTERLOCK
          LX1    6-0         CHECK JOB ADVANCE
          BX1    X1*X3
          BX1    X1+X0
          NZ     X1,EJT7     IF JOB ADVANCE OR INTERLOCK SET
          SX1    X6-ENEJ
          ZR     X1,EJT2     IF ENABLE JOB REQUEST
          SX4    X6-FJEJ
          MX1    -6
          BX3    -X1*X3
          SB3    EJT0.2      *CAL* *ACB* RETURN ADDRESS
          SB6    ACB         *CAL* RETURN ADDRESS - NO LIMIT
          BX1    X1-X1       PRESET NO BUFFER AVAILABLE
          BX0    X2          SAVE ERROR CODE
          NZ     X4,CAL      IF NOT FREEZE JOB REQUEST
          SX3    X3-SIJS*2
          NZ     X3,CAL      IF NOT SWAP-IN JOB STATUS
          EQ     EJT7        RETURN RETRY ERROR CODE
 
 EJT0.2   BX2    X0          RESTORE ERROR CODE
          ZR     X1,EJT7     IF NO BUFFER ASSIGNED
          SA7    A3          SET ENTRY INTERLOCK
          BX7    X1          COMMUNICATIONS BUFFER ADDRESS
          EQ     EJT1.2      CALL *1MA*
 
*         MAKE *1MA* CALL FOR OTHER FUNCTIONS.
 
 EJT1     SB3    EJT1.1      *CAL* *ACB* RETURN ADDRESS
          SB6    ACB         *CAL* RETURN ADDRESS - NO LIMIT
          BX1    X1-X1       PRESET NO BUFFER AVAILABLE
          BX0    X2          SAVE ERROR CODE
          EQ     CAL         CHECK ACTIVITY LIMIT
 
 EJT1.1   BX2    X0          RESTORE ERROR CODE
          ZR     X1,EJT7     IF NO BUFFER ASSIGNED
          BX7    X1          COMMUNICATIONS BUFFER ADDRESS
 EJT1.2   SA4    T1          ABSOLUTE ADDRESS OF BLOCK
          SA7    APQA        SET BUFFER ADDRESS FOR *APQ*
          ERX4   X4          FIRST WORD OF PARAMETER BLOCK
          BX6    X4
          SA4    T2
          SA6    X1+B1       SET WORD IN BUFFER
          ERX1   X4
          SX3    B1
          IX4    X4+X3
          ERX2   X4
          BX6    X1
          BX7    X2
          SA6    A6+B1
          SA7    A6+B1
          SX4    B1          TRANSFER AUTO RECALL BIT
          LX4    40-0
          SX3    X5          GET ADDR
          BX5    X4*X5
          SA4    EJTA        SET UP CALL
          BX4    X4+X3       MERGE ADDR
          SB4    LA1MA       SET PROGRAM TO CALL
          SA2    RA1
          LX5    1
          BX7    X7-X7
          BX6    X4+X5       INSERT AUTO-RECALL FLAG
          EWX7   X2          CLEAR RA+1
          SB3    MTRX        *APQ* RETURN ADDRESS
          ZR     X5,APQ      IF NOT AUTO-RECALL
          SB3    SIS         *APQ* RETURN ADDRESS
          EQ     APQ         ASSIGN PP
 
*         ENEJ - ENABLE JOB FOR SCHEDULING.
 
 EJT2     MX6    -6          VALIDATE JOB STATUS
          SA1    T2          READ SECOND PARAMETER BLOCK WORD ADDRESS
          BX6    -X6*X3
          R=     X2,NDER     JOB NOT DISABLED ERROR CODE
          SX0    X6-IOJS*2
          ZR     X0,EJT3     IF AWAITING INTERACTIVE I/O
          SX0    X6-DOJS*2
          ZR     X0,EJT3     IF DISABLED
          ERX3   X1
          LX6    12          SAVE JOB STATUS
          BX6    X6+X3
          EWX6   X1          REWRITE PARAMETER BLOCK WORD
          EQ     EJT7        PROCESS ERROR
 
 EJT3     ERX1   X1
          MX0    42
          BX2    X0*X1
          SX0    B0
          ZR     X2,EJT5     IF NO ENTRY POINT NAME
          SB6    EJT4        SET REENTRY ADDRESS
          EQ     SCD         SEARCH CENTRAL DIRECTORY
 
*         IF THE SPECIFIED ENTRY POINT IS NOT FOUND, IT IS ASSUMED
*         THAT THE REQUEST IS FOR A LOCAL FILE LOAD.  IN THIS CASE
*         THE FL FOR *LDR=* IS USED.
 
 EJT4     SA1    TPPI        GET FL FOR *LDR=*
          SX0    X1+
          ZR     X7,EJT5     IF ENTRY POINT NOT FOUND
 
*         CALCULATE FL FROM FOUND ENTRY POINT.
 
          SA1    X7          GET FL FIELD
          MX0    10
          LX0    58
          BX0    X0*X1
          LX0    12
 EJT5     SA4    T1          CHECK PPI FIELD
          ERX4   X4
          MX2    -6
          LX4    42
          BX1    -X2*X4
          SX7    MCMX/100B
          MX6    -12
          ZR     X1,EJT6     IF NO PPI SPECIFIED
          SB6    X1-TPPIL
          R=     X2,IPER     INVALID PPI ERROR CODE
          GT     B6,EJT7     IF PPI OUT OF RANGE
          SA1    X1+TPPI     GET PREPROCESSOR FIELD LENGTH/100B
          SX1    X1
          IX2    X0-X1
          PL     X2,EJT6     IF ENTRY POINT FIELD LENGTH IS LARGER
          BX0    X1          MOVE LARGER FL
 EJT6     SA2    A3+SCLE-JSNE  GET USER-S NFL
          BX3    -X6*X2      CURRENT FL
          LX6    12
          BX6    -X6*X2
          ZR     X6,EJT6.1   IF ECS NOT ASSIGNED
          IX6    X3-X7
          IX3    X0-X7
          PL     X6,EJT6.1   IF CURRENT FL .GE. *MCMX*
          PL     X3,EJT6.1   IF FL .GE. *MCMX*
          BX0    X7          SET FL TO *MCMX*
 EJT6.1   IX7    X2+X0       ADD IN SELECTED FL
          SA7    A2
 
*         CALCULATE ENTRY TIME.
 
          AX2    54
          CX1    X2,JCB      CONVERT JCB ORDINAL TO OFFSET
          TA1    X1+EXQT,JCB
          MX3    -12
          BX2    -X3*X1      INITIAL EXECUTION PRIORITY
          NZ     X0,EJT6.2   IF JOB STEP INITATION
 
*         IF JOB STEP INITATION AFTER I/O, USE INTERACTIVE JOB PRIORITY
*         (TP).  OTHERWISE USE INITIAL PRIORITY (IP).
 
          SA2    A1+MCMT-EXQT
          AX2    36
          BX2    -X3*X2
 EJT6.2   AX1    12
          BX6    -X3*X1      WEIGHTING FACTOR (SHIFT COUNT)
          SB6    X6
          AX1    24
          BX1    -X3*X1      LOWER BOUND SCHEDULING PRIORITY
          IX2    X2-X1
          SA1    RTCL        CURRENT TIME
          LX6    X2,B6
          AX1    36
          IX1    X1-X6       ENTRY TIME
          SA2    A3+B1       CLEAR SCHEDULE FIELD
          MX0    30
          BX7    X0*X2
          BX7    X1+X7       MERGE ENTRY TIME
          SA7    A2
          R=     X1,ROJS*2
          SX2    B0
          SA3    A3          CHANGE JOB STATUS
          MX0    54
          BX7    X0*X3
          BX7    X7+X1
          SA7    A3          ENABLE JOB
 EJT7     SA3    T1          PARAMETER BLOCK ADDRESS
          ERX4   X3          FIRST WORD OF PARAMETER BLOCK
          SX6    B1          SET PARAMETER BLOCK COMPLETE
          LX2    10-0
          BX4    X4+X6
          SA1    RA1         READ ADDRESS OF RA+1
          BX7    X7-X7
          BX6    X4+X2       SET ERROR CODE
          EWX7   X1
          EWX6   X3
          EQ     SJS         START JOB SCHEDULER
 
 
 EJTA     VFD    18/3L1MA,6/0,12/5,24/0
 END      SPACE  4
***       *END*.
*         END JOB.
*
*T        18/  *END*,42/
 
 
 END      EQU    SNS         SET NULL STATUS
 LDR      SPACE  4,10
***       *LDR*.
*         REQUEST OVERLAY LOAD.
*
*T        18/  *LDR*,24/,18/  ADDR
*         REQUEST OVERLAY LOAD AS SPECIFIED BY (ADDR).
 
 
 LDR      BSS    0           ENTRY
          SB4    LALDR       SET *LDR* LOAD PARAMETER INDEX
          EQ     AAR1        ASSIGN AS AUTO-RECALL REQUEST
 LDV      SPACE  4,10
***       *LDV*.
*         REQUEST LOADER ACTION.
*
*T        18/  *LDV*,6/,36/  0
*         REQUEST AUTO LOAD OF RELOCATABLE FILE, NAME IN (64B).
*
*T        18/  *LDV*,24/,18/  ADDR
*         REQUEST OVERLAY LOAD AS SPECIFIED BY (ADDR).
 
 
 LDV      BSS    0           ENTRY
          SX6    X4-3RLOD
          SX7    X4-3RMEM
          ZR     X6,LOD      IF *LOD*
          SX6    X4-3RLDX
          ZR     X7,MEM      IF *MEM*
          SX7    X4-3RLDV
          ZR     X6,LDX      IF *LDX*
          NZ     X7,APJ      IF NOT *LDV*
 
*         PROCESS *LDV* REQUEST.
 
          SB5    X5
          ZR     B5,LOD      IF RELOCATABLE
          SX1    B1          SET AUTO RECALL
          SX6    3RLDR&3RLDV CHANGE CALL TO *LDR*
          LX6    42
          BX2    X5-X6
          LX1    40
          BX5    X2+X1
          SB4    LALDR       SET *LDR* LOAD PARAMETER INDEX
          EQ     APJ1        ASSIGN PP
 LDX      SPACE  4,10
***       *LDX*.
*         REQUEST OVERLAY LOAD.
*
*T        18/  *LDX*,6/ R,18/,18/  ADDR
*         REQUEST OVERLAY LOAD AS SPECIFIED BY (ADDR).
*         AUTORECALL IS NOT FORCED FOR SUBSYSTEMS.
 
 
 LDX      BSS    0           ENTRY
          SX6    3RLDR&3RLDX CHANGE CALL TO *LDR*
          LX6    42
          BX5    X5-X6
          SB4    LALDR       SET *LDR* LOAD PARAMETER INDEX
          EQ     APJ0        ASSIGN PP
 LOD      SPACE  4,10
***       *LOD*.
*         REQUEST AUTO LOAD OF RELOCATABLE FILE, NAME IN (64B).
*
*T        18/  *LOD*,6/,36/  0
 
 
 LOD      BSS    0           ENTRY
          SA4    LODA        ENTER *LDR* REQUEST WORDS
          LX1    18          POSITION FIELD LENGTH
          SA2    A4+B1
          BX5    X4
          LX6    X2
          MX7    2
          SA4    B2          READ P, A0, B0
          LX7    42-59       (X7) = 140BS36
          SA3    B3+B0       ADDRESS OF RA
          SX2    X5
          IX3    X3+X2
          SA2    B2+5        READ FLX
          EWX6   X3
          SX6    B1
          IX3    X6+X3
          EWX7   X3
          MX3    42
          LX3    18
          BX4    X3*X4
          AX2    36
          TLX2   (6,ESM170,0)
          BX6    X4+X1       STORE UPDATED (A0)
          LX7    X2
          SA6    B2
          SA7    B2+10B      STORE (X0) ECS FIELD LENGTH
          SB4    LALDR       SET *LDR* LOAD PARAMETER INDEX
          EQ     APJ1        ASSIGN PP
 
 LODA     BSS    0
          CON    0LLDR+1S40+60B
          CON    0LLDR=+100B
 MEM      SPACE  4,40
***       *MEM*.
*         REQUEST MEMORY.
*
*T        18/  *MEM*,6/ ,18/  TYPE,18/  ADDR
*         TYPE   0 IF CM, ABORT IF NOT AVAILABLE
*                1 IF ECS, ABORT IF NOT AVAILABLE
*                2 IF CM, DO NOT ABORT IF NOT AVAILABLE
*                3 IF ECS, DO NOT ABORT IF NOT AVAILABLE
*         ADDR   ADDRESS OF REQUEST WORD
*T ADDR   30/ VAL,24/,1/R,1/C,1/,1/0
*
*         R = CLEAR *CMM* STATUS.
*         C = THIS IS A *CMM* TYPE REQUEST.
*         TYPE CM.
*                IF VAL .GT. 0 THEN
*                   VAL = 12/,1/N,17/FL
*                            N = NO-REDUCE OVERRIDE.
*                            FL = CM FIELD LENGTH.
*         TYPE ECS.
*                IF VAL .GT. 0 THEN
*                   VAL = ECS FIELD LENGTH.
*                IF VAL .EQ. -0 RELEASE ALL ECS FIELD LENGTH.
*
*         TYPE CM OR ECS.
*                IF VAL .EQ. 0 RETURN CURRENT FIELD LENGTH.
*                IF VAL .EQ. -1 RETURN MAXIMUM FIELD LENGTH (MFL).
*
*         RESPONSE.
*T ADDR   30/ FL OR MFL,30/1
*
*         * MONITOR CALL ERROR.* IS RETURNED FOR THE FOLLOWING-
*         1)     ILLEGAL ADDRESS.
*         2)     CLEAR *CMM* STATUS WITH (R) = 1 AND (C) = 0.
*         3)     CLEAR *CMM* STATUS WITH (R) = 1 AND (C) = 1 AND
*                *CMM* JOB STEP STATUS NOT SET.
*
*         A CMM ERROR WILL BE ISSUED BY *1MA* IF JOB STEP CMM
*         STATUS IS SET AND A MEMORY CHANGE REQUEST IS ISSUED THAT
*         DOES NOT HAVE THE (C) BIT SET.
 
 
 MEM      MX6    -23
          SB5    X5          SET REQUEST ADDRESS
          SA3    MP
          GE     B5,B4,CPE   IF ADDRESS .GE. FL
          LE     B5,B1,CPE   IF ADDRESS .LT. 2
          SA2    B3          GET RA ADDRESS
          BX0    -X6*X5      EXTRACT *1MA* PARAMETERS
          SX6    X5
          IX2    X6+X2
          SX6    B1
          ERX2   X2          READ REQUEST WORD
          LX6    18
          IX5    X0+X6       INCREMENT TYPE FIELD
          MX4    -2
          AX2    2           EXTRACT REQUEST TYPE
          BX4    -X4*X2
          AX2    28
 
*         (B6) = *CMM* FIELD OF REQUEST WORD - 1.
 
          SB6    X4-1
          AX7    X2,B1
          LX0    59-18
          SA4    B7+DBAW
          LX6    54-18
          EQ     B6,B1,CPE   IF *CMM* FIELD = 2 ABORT
          PL     X0,MEM1     IF NOT ECS
          LX6    55-54
          PL     X2,MEM1     IF NOT (RELEASE ALL ECS OR MFL REQUEST)
          NZ     X2,MEM1     IF MFL REQUEST
          SX7    B1+         INDICATE NON STATUS ECS REQUEST
 MEM1     BX5    X5+X3       COMPLETE *1MA* REQUEST
          BX3    X6*X4       EXTRACT CMM JOB STEP STATUS
          SB4    LA1MA       SET *1MA* LOAD PARAMETER INDEX
          LE     B6,B1,MEM4  IF CMM FIELD .NE. 3
 
*         REQUEST TO CLEAR CMM FLAG.  THE CLEAR WILL BE DONE IN CPUMTR
*         ONLY IF IT IS NOT POSSIBLE FOR THE REQUEST TO BE
*         REQUEUED AND REPROCESSED.
 
          ZR     X3,CPE      IF JOB STEP CMM FLAG NOT SET ON CLEAR
          NG     X0,APJ1     IF ECS STATUS REQUEST
          NZ     X7,AFL      IF NOT STATUS REQUEST
          BX6    -X6*X4      CLEAR CMM JOB STEP STATUS
          SA6    A4+
 
*         RETURN CM STATUS.
 
 MEM2     SX3    B1
          PL     X7,MEM3     IF NOT MFL REQUEST
          MX6    12
          SA4    B7+FLCW
          BX1    X6*X4
          LX1    -12-30
 MEM3     LX1    30          STORE RESPONSE
          BX7    X7-X7
          BX6    X1+X3
          SA2    B3          RA ADDRESS
          SA1    B3+B1       RA + 1 ADDRESS
          SX3    B5
          IX2    X3+X2
          EWX7   X1          CLEAR RA+1
          EWX6   X2          STORE RESPONSE
          EQ     MTRX        EXIT
 
*         PROCESS CMM REQUEST FIELD = 0, 1.
 
 MEM4     NZ     B6,MEM6     IF CMM FIELD = 0
          BX6    X4+X6       SET CMM JOB STEP STATUS
          SA6    A4
 MEM5     NG     X0,APJ1     IF ECS REQUEST
          ZR     X7,MEM2     IF STATUS REQUEST
          EQ     AFL         ASSIGN FIELD LENGTH
 
 MEM6     ZR     X3,MEM5     IF CMM JOB STEP STATUS CLEAR
          ZR     X7,MEM5     IF STATUS REQUEST
          MX1    36          ABORT WITH CMM ERROR
          BX5    X1*X5
          EQ     APJ0        ASSIGN PP
 MSG      SPACE  4,20
***       *MSG*.
*         SEND MESSSAGE TO SYSTEM.
*
*T,       18/  *MSG*,6/  R,12/  MO,6/  AL,18/  ADDR
*         MO     MESSAGE OPTION
*         AL     ADDRESS LOCATION (0 - USER FL, 40B - NEGATIVE FL).
*         ADDR   ADDRESS OF MESSAGE
*
*         MO     MESSAGE WRITTEN TO
*          0     MASTER DAYFILE, JOB DAYFILE, AND CONTROL POINT
*                MESSAGE BUFFER
*          1     CONSOLE LINE 1
*          2     CONSOLE LINE 2
*          3     JOB DAYFILE AND CONTROL POINT MESSAGE BUFFER
*          4     ERROR LOG (SYSTEM ORIGIN / SSJ= ONLY)
*          5     ACCOUNT FILE (SYSTEM ORIGIN / SSJ= ONLY)
*          6     MASTER DAYFILE (COMMON PRODUCTS COMPATIBILITY)
*          7     JOB DAYFILE (COMMON PRODUCTS COMPATIBILITY)
*         10B          INTERNAL TO *CPUMTR*
*         11B    MAINTENANCE LOG (SYSTEM ORIGIN / SSJ= ONLY)
*         12B    ACCOUNT FILE WITH JSN (SYOT/SSJ= ONLY)
*         13B    JOB DAYFILE ONLY
*
*         NOTES  AN ILLEGAL MESSAGE OPTION WILL CAUSE MO = 1
*                TO BE SELECTED.
 
 
 MSG      LX4    18
          BX6    X5          SAVE REQUEST
          SA6    MSGB
          BX3    X5
          SB5    X5          CHECK MESSAGE ADDRESS
          LX3    59-23
          BX4    -X0*X4      EXTRACT MESSAGE OPTION
          SB6    B5-CSBN-1
          MX6    12
          PL     X3,MSG1     IF NOT CONTROL STATEMENT MESSAGE
          SX7    B5-MS1W
          NZ     X7,MSG0     IF NOT *MS1W*
          SX7    B7          USE CPA ADDRESS AS RA
          SA7    B3
          SB4    200B        SET FL TO LENGTH OF CPA
          EQ     MSG1        ISSUE MESSAGE
 
 MSG0     SA1    B3          SET RA TO BEGINNING OF BUFFER
          SX7    CSBN+2
          IX7    X1-X7
          SA7    B3
          PL     B6,CPE      IF NOT IN CONTROL STATEMENT BUFFER
          SB4    CSBN-INSN+7  SET LENGTH OF BUFFER
          SB5    B6-B1       CHANGE NFL ADDRESS TO BUFFER INDEX
          SB5    -B5
 MSG1     GE     B5,B4,CPE   IF ILLEGAL MESSAGE ADDRESS
          SB6    B4-5
          LE     B5,B1,CPE   IF ILLEGAL MESSAGE ADDRESS
          SA1    B3
          SX2    B5
          IX1    X1+X2
          ERX2   X1          READ FIRST WORD OF MESSAGE
          BX7    X6*X2
          LX6    X2
          SX5    B1+
          ZR     X2,MSG2     IF NULL MESSAGE
          NZ     X7,MSG2     IF MESSAGE PRESENT
          BX7    X2+X5       SET OPERATION COMPLETE
          AX2    30
          SB5    X2
          GE     B5,B4,CPE   IF ILLEGAL MESSAGE ADDRESS
          EWX7   X1
          LE     B5,B1,CPE   IF ILLEGAL MESSAGE ADDRESS
          SA1    B3
          SX2    B5
          IX1    X1+X2
          ERX2   X1          READ FIRST WORD OF MESSAGE
          BX6    X2
 MSG2     GT     B5,B6,CPE   IF MESSAGE ADDRESS + 5 .GT. FL
          SB6    X4-TMSGL
          PL     B6,TMSG+1   IF ILLEGAL OPTION ASSUME 1
          JP     TMSG+TMSGL+B6
 
 TMSG     BSS    0           MESSAGE PROCESSOR TABLE
 
 +        EQ     MSG7        PREPROCESS MASTER DAYFILE MESSAGE
 
 +        SA6    B7+MS1W     SET MESSAGE IN LINE 1 OF CONTROL POINT
          EQ     MSG3
 
 +        SA6    B7+MS2W     SET MESSAGE IN LINE 2 OF CONTROL POINT
          EQ     MSG4
 
 +        EQ     MSG7        PREPROCESS JOB DAYFILE MESSAGE
 
 +        EQ     MSG5        PREPROCESS ERROR LOG MESSAGE
 
 +        EQ     MSG5        PREPROCESS ACCOUNT FILE MESSAGE
 
 +        SX4    0
          EQ     MSG6        CHANGE MESSAGE OPTION TO MASTER DAYFILE
 
 +        SX4    CPON/10000B
          EQ     MSG6        CHANGE MESSAGE OPTION TO JOB DAYFILE
 
 +        EQ     MSG7        PREPROCESS JOB DAYFILE MESSAGE
 
          SX4    BMLN/10000B
          EQ     MSG4.0      PREPROCESS MAINTENANCE LOG MESSAGE
 
 +        SX4    AJNN/10000B
          EQ     MSG4.1      PREPROCESS ACCOUNT MESSAGE WITH JSN
 
 +        SX4    CDON/10000B
          EQ     MSG6        CHANGE MESSAGE OPTION FOR *DFMM*
 
 TMSGL    EQU    *-TMSG
 
*         FIRST CONSOLE MESSAGE.
 
 MSG3     IX1    X1+X5
          ERX3   X1
          IX1    X1+X5
          ERX2   X1
          LX7    X3
          BX6    X2
          SA7    A6+B1
          SA6    A7+B1
 
*         SECOND CONSOLE MESSAGE.
 
 MSG4     IX1    X1+X5
          ERX3   X1
          IX1    X1+X5
          ERX2   X1
          LX7    X3
          BX6    X0*X2       TERMINATE MESSAGE
          SA7    A6+B1
          BX7    X0-X0
          SA6    A7+B1
          EQ     MTRP        CLEAR RA+1
 
*         ENTER HERE TO PREPROCESS MAINTENANCE LOG MESSAGE (MO = 11B).
 
 MSG4.0   SB6    B0
          AX6    48
 
*         ENTER HERE TO CHANGE MESSAGE OPTION (MO = 12B).
 
 MSG4.1   SA1    RA1         READ REQUEST
          LX0    24
          ERX5   X1
          BX5    X0*X5       REMOVE CURRENT MESSAGE OPTION
          LX4    24
          BX7    X5+X4       INSERT NEW OPTION
          MX0    -12
          EWX7   X1          RESET REQUEST
          BX5    X7
 
*         ENTER HERE TO CHECK JOB ORIGIN AND SSJ (MO = 4, 5).
 
 MSG5     SA3    B7+TFSW     GET JOB EJT ORDINAL
          MX1    -12
          LX3    12
          BX3    -X1*X3
          MX4    -4
          CX2    X3,EJT      CONVERT EJT ORDINAL TO OFFSET
+         ZR     X3,*        IF NO EJT ORDINAL
          TA3    X2+SCLE,EJT GET JOB ORIGIN
          LX3    -48
          BX3    -X4*X3
          SX3    X3-SYOT
          ZR     X3,MSG8     IF SYSTEM ORIGIN JOB
          SA1    B7+SEPW
          BX7    X7-X7
          LX1    59-50
          NG     X1,MSG8     IF SSJ JOB
          ZR     B6,MTRX     IF MO = BINARY MAINTENANCE LOG
          SX4    CPON/10000B
 
*         ENTER HERE TO CHANGE MESSAGE OPTION (MO = 6, 7, 13B).
 
 MSG6     LX0    24
          SA1    RA1         READ REQUEST
          ERX5   X1
          BX5    X0*X5       REMOVE CURRENT MESSAGE OPTION
          LX4    24
          BX5    X5+X4       INSERT NEW OPTION
          MX0    -12
          BX7    X5
          EWX7   X1          RESET REQUEST
 
*         ENTER HERE TO CHECK MESSAGE LIMIT EXCEEDED (MO = 0, 3).
 
 MSG7     SA1    B7+ACLW
          LX1    12
          AX1    48
          NZ     X1,MSG8     IF MESSAGE LIMIT NOT EXCEEDED
          NG     X1,MSG8     IF UNLIMITED USER
          SX7    MLET        MESSAGE LIMIT ERROR
          JP     SEF         SET ERROR FLAG
 
 MSG8     SA2    B3          RA
          SX4    B5          SAVE RELATIVE FWA
          ZR     B6,MSG11    IF BINARY MESSAGE
          SB6    B5+MCML-2
          SX4    B5-1        SET MESSAGE ADDR-1
          SX0    -5          PRESET MASK INDEX FOR CODED MESSAGE
          SA3    MSGA
 
*         DETERMINE WORD COUNT OF CODED MESSAGE.
 
 MSG9     SX1    B5
          IX1    X2+X1
          ERX1   X1          READ NEXT WORD
          SB5    B5+B1       ADVANCE MESSAGE ADDRESS
          EQ     B5,B6,MSG10 IF MAXIMUM MESSAGE LENGTH
          GT     B5,B4,CPE   IF ILLEGAL ADDRESS
          ZR     X1,MSG10    IF EOM
          BX6    X3*X1       EXTRACT LOW ORDER BITS FROM EACH BYTE
          BX7    -X3*X1
          IX6    X6+X3       NON-ZERO CHARACTER PAIRS PRODUCE CARRY
          LX7    -11
          NO
          IX6    X6+X7       COMPENSATE FOR *5:* (DISPLAY CODE 4000B)
          BX7    -X3*X6
          BX6    -X3-X7      CHECK FOR 5 NON-ZERO BYTES
          ZR     X6,MSG9     IF WORD HAS NO EOM BYTE
          PL     X7,MSG10    IF EOM IN BYTE 0
 +        LX7    12
          SX0    X0+B1       ADVANCE INDEX FOR EOM MASK
          NG     X7,*        IF EOM BYTE NOT REACHED
 MSG10    SB6    X4+B1       FWA
          SX6    B5-B6       SET MESSAGE LENGTH
          EQ     MSG14       GO ISSUE MESSAGE TO DAYFILE
 
*         CHECK LENGTH OF BINARY MESSAGE.
 
 MSG11    PL     X6,MSG13    IF MESSAGE LENGTH .GE. 0
 MSG12    SX6    MBML-2      SET MAXIMUM MESSAGE LENGTH
 MSG13    SB6    X6-MBML+1
          PL     B6,MSG12    IF INVALID MESSAGE LENGTH
          SB5    B5+X6
          SB6    B5+B1
          GE     B6,B4,CPE   IF EOM BEYOND FL
          SX1    B5
          BX0    X0-X0       DEFINE MASK INDEX
          IX1    X1+X2
          ERX1   X1          READ LAST WORD
 MSG14    IX4    X4+X2       ABSOLUTE FWA
          SA5    RA1
          MX2    1           SET *MSG* FLAG
          ERX5   X5          READ REQUEST
          JP     DFM2        ISSUE MESSAGE TO DAYFILE
 
 MSGA     DATA   37773777377737773777B
 MSGB     BSS    1           ORIGINAL *MSG* REQUEST
 PFL      SPACE  4
***       *PFL*.
*         SET (P) AND CHANGE FIELD LENGTH.
*
*T        18/  *PFL*,6/,18/  P,18/  FL
*         P      NEW (P)
*         FL     NEW FIELD LENGTH
 
 
 PFL      SX7    X4-3ROPE
          SB5    X4-3RPFL
          ZR     X7,CLO      IF *OPE*, CONVERT TO *CIO*
          NZ     B5,APJ      IF NOT *PFL*
 
*         PROCESS *PFL* REQUEST.
 
          MX2    18
          SA3    B2          READ EXCHANGE PACKAGE
          LX2    -6
          BX6    -X2*X3      CLEAR (P)
          LX5    18
          BX4    X2*X5       EXTRACT NEW (P)
          BX5    -X2*X5      REFORMAT *PFL* REQUEST TO *RFL* REQUEST
          BX6    X4+X6       MERGE NEW (P)
          LX5    -18
          SA6    B2          STORE EXCHANGE PACKAGE
          EQ     RFL
 RCL      SPACE  4,10
***       *RCL*.
*         PLACE PROGRAM ON RECALL.
*
*         ENTRY  (X7) = 0.
*
*T        18/  *RCL*,1/ ,1/0,40/
*         PLACE PROGRAM ON RECALL UNTIL SYSTEM RECALL DELAY HAS
*         EXPIRED.
*
*T        18/  *RCL*,1/ ,1/1,22/,18/  STATUS
*         PLACE PROGRAM ON RECALL UNTIL BIT 0 OF (STATUS) IS SET.
*         JOBS WILL BE CHECKED FOR PENDING *RCLP* BY *MTR* PP RECALL.
*
*         EXIT   TO *SXR* IF *RCLP*.
*                TO *SXS* IF *RCL*.
*                TO *CPE* IF BAD ADDRESS ON *RCLP*.
*                TO *MTRX* IF *RCLP* REQUEST COMPLETE.
 
 
*         PROCESSED INLINE IN *CPR* DUE TO USAGE.
 RFL      SPACE  4,10
***       *RFL*.
*         REQUEST FIELD LENGTH.
*
*T        18/  *RFL*,6/,18/  ADDR,1/N,17/  FL
*         ADDR   ADDRESS FOR STATUS RESPONSE
*         N      NO-REDUCE OVERRIDE
*         FL     FIELD LENGTH
*
*         IF FL = 0, CURRENT FIELD LENGTH WILL BE RETURNED
*
*         RESPONSE.
*T ADDR   12/  0,18/  FL,30/  1
 
 
 RFL      MX6    -18         EXTRACT FL
          SA4    MP          READ *1MA* CALL
          BX2    -X6*X5
          SA3    B7+DBAW     CHECK IF CMM JOB STEP STATUS SET
          AX5    18
          SB5    X5          SET STATUS ADDRESS
          LX3    59-54
          BX5    X4
          GT     B5,B4,CPE   IF ADDRESS .GE. FL
          ZR     X2,RFL1     IF STATUS REQUEST
          NG     X3,RFL2     IF CMM JOB STATUS SET
 RFL1     BX5    X5+X2
          ZR     B5,AFL      IF NO STATUS REQUEST
 
*         CONVERT *RFL* TO *MEM* REQUEST.
 
          LX2    30
          SX5    B5
          BX6    X2
          LE     B5,B1,CPE   IF ADDRESS .LT. 2
          SA2    B3+
          IX2    X2+X5
          EWX6   X2
          EQ     MEM
 
 RFL2     SB4    LA1MA       SET *1MA* LOAD PARAMETER INDEX
          EQ     APJ1        ASSIGN PP
 RPV      SPACE  4,10
***       *RPV.*
*         REPRIEVE CENTRAL PROGRAM.
*
*         THIS REQUEST IS TRAPPED IN ORDER TO FORCE AUTO RECALL.
*         THIS ENSURES PROPER INTERLOCKING OF THE CONTROL POINT
*         AREA WHILE ALLOWING FOR EXISTING PROGRAMS THAT MAY
*         CALL *RPV* WITHOUT AUTO RECALL.
 
 
 RPV      EQU    AAR         ASSIGN *RPV* AS AUTO RECALL REQUEST
 RSB      SPACE  4,50
***       *RSB*.
*         READ SUB-SYSTEM PROGRAM BLOCK.
*
*T        18/  *RSB*,1/ ,1/R,4/ ,6/0,12/  SID,18/  STAT
*         R = 1 IF AUTO RECALL SELECTED.
*         SID = SUBSYSTEM IDENTIFICATION.
*                IF SID = 0, THEN BLOCK IF READ FROM CORE MEMORY OR
*                RELATIVE TO CALLERS CONTROL POINT.
*         STAT = ADDRESS OF STATUS WORD IN FORMAT -
*
*T STAT   12/0,12/  WC,18/  ADDR,18/  BUFF
*         WC = NUMBER OF WORDS TO BE READ.
*         ADDR = ADDRESS TO READ FROM IN SUB-SYSTEM.
*         BUFF = ADDRESS OF BUFFER TO RECEIVE DATA.
*
*
*         A BLOCK OF DATA OF LENGTH WC WHERE WC < 101B WILL BE
*         TRANSFERRED FROM SUBSYSTEM WITH IDENTIFICATION SID.
*         BEGINNING AT LOCATION ADDR TO A BUFFER IN THE CALLING
*         PROGRAM THAT BEGINS AT LOCATION BUFF.  IF ADDR IS NEGATIVE,
*         THE TRANSFER WILL BE FROM THE SUBSYSTEM-S NFL.
*
*
*         WHEN SID = 0, THE CONTENTS OF BUFF DETERMINE WHETHER THE
*         READ IS FROM CENTRAL MEMORY RESIDENT OR IS RELATIVE TO
*         THE CALLER-S CONTROL POINT.  IF BIT 59 OF BUFF IS ONE,
*         THE READ IS FROM CMR, AND ADDR IS THE ABSOLUTE ADDRESS
*         AT WHICH TO BEGIN THE READ.  IF BIT 59 OF BUFF IS ZERO,
*         THEN THE READ IS RELATIVE TO THE CALLER-S CONTROL POINT
*         AND IS EITHER A SELECTIVE OR A BLOCK READ.
*
*T BUFF   1/C, 23/ 0, 18/ B, 18/ CPAW
*         C = 1, IF CMR READ.
*         C = 0, IF CONTROL POINT READ.
*         B = 0, SELECTIVE READ.
*         B = 1, BLOCK READ.
*         CPAW = CONTROL POINT AREA WORD TO READ.
*
*         IF THE READ IS SELECTIVE, BUFF CONTAINS A LIST OF ADDRESSES
*         TO READ.  THE LIST TERMINATES AT WC OR WITH A ZERO ENTRY.
*         THE WORD READ IS STORED IN THE BUFF LOCATION CONTAINING ITS
*         ADDRESS.  B CAN ONLY BE SPECIFIED IN (BUFF+0).
*         IF THE READ IS A BLOCK READ, WC WORDS, BEGINNING WITH THE
*         ADDRESS SUPPLIED (CPAW), ARE READ AND STORED IN BUFF.
*
*
*         THE CALLING PROGRAM MUST HAVE EITHER A SSJ= ENTRY POINT OR A
*         SUBSYSTEM IDENTIFICATION.
*
*
*         RESPONSE
*T  STAT  12/  REPLY,12/  WC,18/  ADDR,18/  BUFF
*         REPLY = 4000  TRANSFER SUCCESSFULLY COMPLETED.
*                 2000  SUB-SYSTEM NOT PRESENT.
 
 
 RSB      BSS    0           ENTRY
          SA2    B7+JCIW     CHECK SUBSYSTEM IDENTIFICATION
          SA4    B7+SEPW     CHECK FOR SSJ=
          AX2    24
          BX2    -X0*X2
          SX2    X2-LSSI-1
          LX4    59-50
          BX4    -X2+X4
          PL     X4,APJ      IF CALL CONDITIONS NOT MET
          SB5    X5
          LX5    -18
          LE     B5,B1,CPE   IF *STAT* .LE. 1
          GE     B5,B4,CPE   IF *STAT* .GE. FL
          SX1    X5          (X1) = SUBSYSTEM IDENTIFICATION
          SA3    B3          RA
          SX4    B5          RELATIVE STATUS ADDRESS
          IX3    X3+X4       RA + STAT
          BX7    X3
          ERX3   X3          READ (STAT)
          SA7    T1          SAVE STATUS ADDRESS
          SB5    X3          (B5) = *BUFF*
          AX3    18
          LE     B5,B1,CPE   IF *BUFF* .LE. 1
          SX4    X3          (X4) = *ADDR*
          AX3    18
          SB6    B5+X3       BUFF + WC
          PX5    X6          PRESET NOT PRESENT STATUS
          LE     B6,B5,CPE   IF WC .LT. 1
          GE     B6,B4,CPE   IF BUFF + WC .GE. FL
          SB6    100B
          SB4    X3          (B4) = WC
          SA2    B3          RA
          SX6    B5          BUFF
          IX6    X2+X6
          SA6    T2          SAVE BUFFER ADDRESS
          GT     B4,B6,CPE   IF WC .GT. 100
          SB3    RSB2        *RSC* RETURN ADDRESS
          NZ     X1,RSC      IF SUB-SYSTEM READ
          SA2    FLSW        SET FL TO CMR SIZE
          MX3    0           SET RA TO ZERO FOR LOW CORE UPDATE
          BX6    -X0*X2
          SA1    T2          GET BUFFER ADDRESS
          ERX1   X1
          LX6    6
          SX6    X6+B1       SET FL TO SIZE OF CMR+1
          NG     X1,RSB2.1   IF LOW CORE READ
          SX4    X1
          LX1    59-18
          SB6    -200B
          SX3    B7+         SET RA TO START OF CP AREA
          SX6    B1-B6       SET *FL* TO LENGTH OF CP AREA + 1
          NG     X1,RSB2.1   IF BLOCK READ OF CONTROL POINT AREA
          LX1    18-59
          MX5    1           COMPLETION STATUS
 
*         SELECTIVE READ OF CONTROL POINT AREA.
 
 RSB1     SX1    X1+
          NG     X1,CPE      IF ADDRESS OUT OF RANGE
          SX7    X1+B6
          PL     X7,CPE      IF ILLEGAL CONTROL POINT AREA ADDRESS
          SA4    B7+X1       READ CONTROL POINT AREA WORD
          BX6    X4
          SA1    T2          GET BUFFER ADDRESS
          EWX6   X1
          LE     B4,B1,RSB3  IF TRANSFER COMPLETE
          SX7    B1
          IX7    X7+X1
          ERX1   X7          READ NEW ADDRESS
          SA7    T2          SAVE
          SB4    B4-B1
          NZ     X1,RSB1     IF CONTINUING SELECTIVE READ
          EQ     RSB3
 
*         RSC EXIT ADDRESSES.
 
          VFD    12/RSB3-RSB2,18/CPE,12/SXS-RSB2,18/SXS
 
*         READ SUBSYSTEM FL OR NFL.
 
 RSB2     SA2    A2-STSW+FLSW  GET NFL
          AX2    48          NFL/100B
          LX2    6           NFL
          IX3    X3-X2       SET RA TO RA-NFL
          IX4    X4+X2       BIAS *ADDR* BY NFL
          IX6    X6+X2       SET FL TO FL+NFL
 
*         PERFORM BLOCK READ.
 
 RSB2.1   SX7    X4+B4       ADDR + WC
          NG     X4,CPE      IF ADDR .LT. ZERO
          SX4    X4
          IX6    X7-X6
          MX5    1           SET COMPLETION STATUS
          PL     X6,CPE      IF ADDR + WC .GE. FL
          IX0    X4+X3       FWA OF SUBSYSTEM READ
          SA1    T2          BUFF
          IX1    X0-X1       DIFF
          SB6    RSB3        SET *MSM* *MSR* RETURN
          TJP    (/CME/MSR,CME,/MONITOR/MSM,CMUMTR,/MONITOR/MSR)
 
*         RETURN COMPLETION STATUS.
 
 RSB3     SA3    T1          STAT ADDRESS
          ERX4   X3          READ STAT
          BX6    X5+X4
          MX7    0
          EWX6   X3          STORE STATUS
          JP     MTRP        EXIT TO STORE OUTPUT REGISTER
 SIC      SPACE  4,40
***       *SIC*.
*         SEND INTER-CONTROL POINT BLOCK TO SUBSYSTEM PROGRAM.
*
*         CONTROL IS ALSO TRANSFERRED HERE FOR SYSTEM CONTROL POINT
*         FUNCTIONS *SSC* AND *SSF*.
*
*T        18/  *SIC*,1/ ,1/R,4/ ,18/  BUFF,18/  STAT
*         R= 1 IF AUTO RECALL SELECTED.
*         BUFF= ADDRESS OF BUFFER TO BE TRANSFERRED TO SUBSYSTEM.
*         STAT= ADDRESS OF STATUS WORD IN FORMAT -
*
*T STAT   18/  BN,12/  SID,30/  0
*         BN = BUFFER NUMBER (0 OR 1) OF SUBSYSTEM TO TRANSFER TO.
*         SID = DESTINATION SUBSYSTEM IDENTIFICATION.
*
*         A BLOCK STARTING AT BUFF WILL BE TRANSFERRED TO THE INDICATED
*         SUBSYSTEM. BLOCK LENGTH IS SPECIFIED IN BITS 0-17 OF THE
*         FIRST WORD OF THE BLOCK (BUFF). LENGTH INCLUDES THIS FIRST
*         WORD.  THE LENGTH OF THE BLOCK MUST BE LESS THAN 101B WORDS.
*         THE CALLER MUST BE A SUBSYSTEM OR HAVE AN SSJ= ENTRY POINT.
*
*         RESPONSE.
*T STAT   18/  BN,12/  SID,30/  REPLY
*         REPLY= 1 IF TRANSFER COMPLETED SUCCESSFULLY.
*                3 IF DESTINATION SUBSYSTEM IS NOT PRESENT IN THE
*                  SYSTEM.
*                5 IF SUBSYSTEM BUFFER IS FULL, SUBSYSTEM BEING MOVED,
*                  OR SUBSYSTEM JOB IS ADVANCING.
*                7 IF BLOCK LENGTH AS SPECIFIED IN THE FIRST WORD IS
*                  LARGER THAN THAT PERMITTED BY THE SUBSYSTEM.
*               11 IF DESTINATION BUFFER IS UNDEFINED BY SUBSYSTEM.
*
*         IF AUTO-RECALL IS SELECTED AND CONDITION 5 ABOVE IS PRESENT,
*         THE CALLING PROGRAM IS PLACED IN RECALL STATUS UNTIL THE
*         CONDITION ENDS.
 
 
 SIC      SX6    X4-3RSIC
          TNZ    X6,(/MONITOR/SSC,SCP,/MONITOR/APJ)  IF NOT SIC
 
*         PROCESS *SIC* REQUEST.
 
          SA2    B7+JCIW     CHECK FOR SUBSYSTEM
          SA4    B7+SEPW     CHECK *SSJ=*
          AX2    24
          LX4    59-50
          BX2    -X0*X2      SUBSYSTEM ID
          BX4    -X4
          SX2    X2-LSSI-1
          SB5    X5+         SET *STAT* ADDRESS
          BX2    X4*X2
          LX5    -18
          NG     X2,APJ      IF CALLER NOT SUBSYSTEM OR SSJ= PROGRAM
          LE     B5,B1,CPE   IF *STAT* .LE. 1
          GE     B5,B4,CPE   IF *STAT* .GE. FL
          SB6    X5          SET *BUFF* ADDRESS
          SA4    B3          RA
          SX3    B5          STATUS ADDRESS
          IX7    X3+X4
          ERX3   X7          READ (STAT)
          SX5    X5
          SA7    T1          SAVE STATUS ADDRESS
          LE     B6,B1,CPE   IF *BUFF* .LE. 1
          GE     B6,B4,CPE   IF *BUFF* .GE. FL
          AX3    30
          BX1    -X0*X3      (X1) = SUBSYSTEM IDENTIFICATION
          IX7    X4+X5
          ERX4   X7          READ (BUFF)
          SA7    T2
          AX3    12
          SB6    B6+X4       LWA + 1 OF *BUFF*
          GE     B6,B4,CPE   IF BUFF + WC .GE. FL
          SB4    X4+         WORD COUNT
          LT     B4,B1,CPE   IF WC .LT. 1
          SB5    100B
          BX5    X4          SAVE FIRST WORD OF TRANSFER
          SX7    B1
          SB3    SIC1        *RSC* RETURN ADDRESS
          BX7    X7*X3       CHECK BUFFER NUMBER
          BX3    X3-X7
          GT     B4,B5,CPE   IF WORD COUNT .GT. 100B
          SX4    ICAN
          ZR     X3,RSC      IF BUFFER NUMBER .GT. 1
          EQ     CPE         PROCESS CALL ERROR
 
*         *RSC* EXIT ADDRESSES.
 
          VFD    12/SIC7-SIC1,18/CPE,12/SIC8-SIC1,18/SIC8
 
 SIC1     IX1    X3-X4       BUFFER POINTER WORD ABSOLUTE ADDRESS
          ERX1   X1          READ BUFFER POINTERS
          SB5    X6+         (B5) = SUBSYSTEM FL
          MX0    -6
          NZ     X7,SIC2     IF BUFFER 1
          LX1    -24
 SIC2     SB3    X1          BUFFER RELATIVE ADDRESS
          AX1    18
          ZR     B3,SIC5     IF BUFFER UNDEFINED
          BX1    -X0*X1
          SB6    X1+B1       BUFER LENGTH
          GT     B4,B6,SIC6  IF BLOCK TOO LONG FOR BUFFER
          SB6    B3+B4       BUFFER ADDRESS + WC
          GT     B6,B5,SIC7  IF BUFFER OUTSIDE OF FL
          SX1    B3          BUFFER FWA
          IX7    X1+X3       BUFFER ABSOLUTE ADDRESS
          SA7    T3          SAVE SUBSYSTEM BUFFER ADDRESS
          ERX2   X7          READ SUBSYSTEM BUFFER
          NZ     X2,SIC8     IF BUFFER FULL
          SB4    B4-B1
          SX0    B1
          IX7    X7+X0       SUBSYSTEM BUFFER + 1
          SA1    T2          BUFFER FWA
          IX0    X1+X0       FWA TO MOVE FROM
          IX1    X0-X7       DIFFERENCE OF ADDRESSES
          SB6    SIC3        *MSM* *MSR* RETURN ADDRESS
          TJP    (/CME/MSR,CME,/MONITOR/MSM,CMUMTR,/MONITOR/MSR)
 
 SIC3     BX7    X5          STORE FIRST WORD
          SX6    B1          COMPLETION STATUS
          SA4    T3
          TIC    DCPC        INVALIDATE CACHE ON OTHER CPU, IF PRESENT
          EWX7   X4
 
*         RETURN COMPLETION STATUS.
 
 SIC4     SA3    T1
          ERX4   X3          REREAD STATUS WORD
          MX0    30
          BX4    X0*X4
          MX7    0
          BX6    X4+X6
          EWX6   X3
          EQ     MTRP        EXIT TO CLEAR RA+1
 
*         PROCESS DESTINATION BUFFER UNDEFINED BY SUBSYSTEM.  (11)
 
 SIC5     SX6    11B
          EQ     SIC4
 
*         PROCESS BLOCK TOO LARGE FOR SUBSYSTEM BUFFER.  (7)
 
 SIC6     SX6    7
          EQ     SIC4
 
*         PROCESS SUBSYSTEM NOT PRESENT IN SYSTEM.  (3)
 
 SIC7     SX6    3
          EQ     SIC4
 
*         PROCESS SUBSYSTEM MOVING, ADVANCING OR BUFFER FULL.
 
 SIC8     SA5    RA1         RA+1 ADDRESS
          ERX5   X5          CHECK FOR AUTO RECALL
          LX5    59-40
          SX6    5
          PL     X5,SIC4     IF AUTO RECALL NOT SPECIFIED
          EQ     SXS         PLACE CALLER IN AUTO RECALL
 SPC      SPACE  4,10
***       *SPC*.
*         PROCESS SPECIAL PP REQUEST.  VALID ONLY FROM SYSTEM JOB.
*
*T        18/ *SPC*, 24/, 18/ ADDR
*         ADDR   ADDRESS OF PPU REQUEST
 
 
 SPC      SA1    B7+JCIW
          SB5    X5
          AX1    24
          LE     B5,B1,CPE   IF ADDRESS .LE. 1
          GE     B5,B4,CPE   IF ADDRESS PAST FL
          BX3    -X0*X1
          SA4    B3          READ PP REQUEST
          SX6    X5
          IX2    X6+X4
          ERX4   X2
          BX6    X4
          LX4    18
          ZR     X3,APJ      IF NOT SYSTEM JOB
          SX5    X4-3R1ZZ-1
          SX4    X4-3RAAA
          BX4    -X4*X5
          PL     X4,CPE      IF ILLEGAL PROGRAM NAME
          SA5    B3+B1       CLEAR (RA+1)
          EWX7   X5
          SB6    SPC1        *CAL* RETURN ADDRESS - NO LIMIT
          BX5    X2          SAVE ADDRESS OF REQUEST
          SB3    MTRX        *CAL* RETURN ADDRESS - ACTIVITY LIMIT
          EQ     CAL         CHECK ACTIVITY LIMIT
 
 SPC1     EWX7   X5          CLEAR REQUEST WORD
          SB4    B0          SET LIBRARY SEARCH NEEDED
          SA7    APQA
          LX6    18
          SX4    X6-3RCIO
          LX6    -18
          TNZ    X4,(/DCP/APQ,DCPC,/MONITOR/APQ)  IF NOT *CIO*
          SA6    /CPUCIO/IR
          SA7    /CPUCIO/MB
          EQ     /CPUCIO/CPC  PROCESS *CIO* REQUEST
 TIM      SPACE  4,45
***       *TIM*.
*         REQUEST SYSTEM TIME.
*
*T        18/  *TIM*,6/,12/  OP,6/,18/  ADDR
*         OP     TIME OPTION
*         ADDR   ADDRESS FOR RESPONSE
*
*
*         OP     RESPONSE
*
*         0      ACCUMULATED CPU TIME
*T ADDR   3/2,45/  SECONDS,12/  MILISEC.
*
*         1      DATE
*T ADDR   60/  * YY/MM/DD.*
*
*         2      CLOCK
*T ADDR   60/  * HH.MM.SS.*
*
*         3      JULIAN DATE
*T ADDR   24/  0,36/  * YYDDD*
*
*         4      SCOPE FORMAT REAL TIME
*T ADDR   24/0, 36/ SECONDS*4096
*
*         5      REAL TIME
*T ADDR   24/  SECONDS,36/  MILLISECONDS
*
*         6      PACKED DATE/TIME
*T ADDR   24/  0,6/ Y-70,6/  MM,6/ DD,6/  HH,6/  MM,6/  SS
*
*         7      ACCUMULATED SRUS
*T ADDR   12/  2000B,12/  0,36/  MILLI-UNITS
*
*         11     ACCUMULATED CYBER 176 CPU CLOCK CYCLE COUNT FOR JOB.
*T ADDR   12/  TYPE,48/  CLOCK CYCLE COUNT
*                TYPE = 2000B, IF CLOCK CYCLE COUNT IS AVAILABLE.
*                TYPE = 6000B, IF CLOCK CYCLE COUNT IS NOT AVAILABLE.
*
*         12     ACCUMULATED CYBER 176 CPU CLOCK CYCLE COUNT SINCE
*                DEADSTART.
*T ADDR   12/  TYPE,48/  CLOCK CYCLE COUNT
*                TYPE = 2000B, IF CLOCK CYCLE COUNT IS AVAILABLE.
*                TYPE = 6000B, IF CLOCK CYCLE COUNT IS NOT AVAILABLE.
*
*         13     DATE WITH 4-DIGIT YEAR
*T ADDR   60/  *YYYY/MM/DD*
*
*         14     JULIAN DATE WITH 4-DIGIT YEAR
*T ADDR   18/  0,42/  *YYYYDDD*
*
*         15     JULIAN DATE WITH *ISO* CENTURY CHARACTER
*T ADDR   24/  0,36/  *CYYDDD*
*                C = * * FOR 19YY YEARS, *0* FOR 20YY YEARS.
 
 
 TIM      SB5    X5          CHECK RESPONSE ADDRESS
          LE     B5,B1,CPE   IF ILLEGAL ADDRESS
          AX5    24
          GE     B5,B4,CPE   IF ADDRESS OUT OF RANGE
          BX4    -X0*X5      SET OPTION
          SB6    X4-TTIML
          PL     B6,TTIM     IF UNIDENTIFIED, ASSUME 0
          JP     TTIM+TTIML+B6
 
 TTIM     BSS    0
 
*         OPTION 0 - ACCUMLATED CPU TIME.
 
 +        SB3    TIM3        UPDATE CPU TIME
          TJP    (/NVE/CPT,NVE,/CME/CPT,CME,/MONITOR/CP76,CP176,/MONITOR
,/CPT)
 
*         OPTION 1 - DATE.
 
 +        SA1    DTEL        DATE
          EQ     TIM1
 
*         OPTION 2 - CLOCK.
 
 +        SA1    TIML        CLOCK
          EQ     TIM1
 
*         OPTION 3 - JULIAN DATE.
 
 +        SA1    JDAL        JULIAN DATE
          JP     TIM1
 
*         OPTION 4 - SCOPE FORMAT REAL TIME.
 
 +        SA1    RTCL        REAL TIME CLOCK
          JP     TIM2
 
*         OPTION 5 - REAL TIME.
 
 +        SA1    RTCL        REAL TIME CLOCK
          EQ     TIM1
 
*         OPTION 6 - PACKED DATE/TIME.
 
 +        SA1    PDTL        PACKED DATE
          EQ     TIM1
 
*         OPTION 7 - ACCUMULATED SRUS.
 
+         SB3    TIM5        UPDATE CPU TIME AND SRU ACCUMULATOR
          TJP    (/NVE/CPT,NVE,/CME/CPT,CME,/MONITOR/CP76,CP176,/MONITOR
,/CPT)
 
*         OPTION 10 - UNIDENTIFIED OPTION.
 
+         EQ     TTIM+0      UNIDENTIFIED OPTION, ASSUME OPTION = 0
 
*         OPTION 11 - ACCUMULATED CLOCK CYCLE COUNT FOR JOB.
 
+         SB3    TIM7        ACCUMULATED JOB CLOCK CYCLE COUNT
          TEQ    (/MONITOR/CP76,CP176,/MONITOR/TIM6)
 
*         OPTION 12 - ACCUMULATED CLOCK CYCLE COUNT SINCE DEADSTART.
 
+         SB3    TIM8        *CPT* RETURN ADDRESS
          TEQ    (/MONITOR/CP76,CP176,/MONITOR/TIM6)  COMPUTE CP TIME
 
*         OPTION 13 - DATE WITH 4-DIGIT YEAR.
 
+         SA1    DTEL        DATE
          EQ     TIM12       EXPAND TO 4-DIGIT YEAR
 
*         OPTION 14 - JULIAN DATE WITH 4-DIGIT YEAR.
 
+         SA1    JDAL        JULIAN DATE
          JP     TIM14       EXPAND TO 4-DIGIT YEAR
 
*         OPTION 15 - JULIAN DATE WITH *ISO* CENTURY CHARACTER.
 
+         SA1    JDAL        JULIAN DATE
          JP     TIM10       ADD *ISO* CENTURY CHARACTER
 
 TTIML    EQU    *-TTIM
 
 TIM1     SA2    RA1         RA+1
          SX7    B5-B1       REQUEST ADDRESS-1
          BX6    X1          STORE REQUEST
          IX3    X2+X7
          BX7    X7-X7
          EWX6   X3          STORE VALUE REQUESTED
          EWX7   X2          CLEAR RA+1
          EQ     MTRX        EXIT
 
*         CONVERT REAL TIME (SCOPE FORMAT).
 
 TIM2     MX2    -36         EXTRACT MILLISECONDS
          SA3    TH+1        =1000.P
          BX6    -X2*X1
          NX2    X3          NORMALIZE DIVISOR
          LX6    12          MILLISECONDS*4096
          PX7    X6
          FX3    X7/X2       MILLISECONDS*4096/1000.P
          UX6    X3,B4       UNPACK RESULT
          LX1    X6,B4
          EQ     TIM1        STORE RESULT
 
*         CONVERT CPU/REAL TIME.
 
 TIM3     SB4    TIM4        SET *DSB* RETURN ADDRESS
          SA2    CPTB        CONVERT QUARTER NANOUNITS TO MILLIUNITS
          EQ     /PROGRAM/MSB  MULTIPLY 60 BIT INTEGER
 
 TIM4     SA2    TH          =.001P48+1
          PX1    X6
          DX6    X2*X1       EXTRACT MILLISECONDS
          FX7    X2*X1       EXTRACT SECONDS
          SA3    TH+1        =1000.P
          UX5    X7
          FX4    X3*X6       SCALE MILLISECONDS
          LX5    12          MERGE MILLISECONDS, SECONDS
          BX1    X5+X4
          EQ     TIM1
 
*         SCALE SRUS TO MILLI-UNITS.
 
 TIM5     SA2    TTH         =.0001P48+1
          SA1    B7+SRUW     SRU ACCUMULATOR
          MX7    -42
          BX7    -X7*X1
          PX1    X7
          FX1    X2*X1       SCALE
          EQ     TIM1        STORE REQUEST
 
*         CYBER 176 CPU CLOCK COUNT UNAVAILABLE.
 
 TIM6     MX1    2           INDICATE CLOCK COUNT UNAVAILABLE
          SB3    A5-B1       RESET (B3)
          EQ     TIM1        STORE RESULT
 
*         ADD *ISO* CENTURY CHARACTER TO *JDATE*.
 
 TIM10    LX1    30
          BX1    X0*X1
          SX6    1R          SPACE MARKS YEAR AS 19YY
          NG     X1,TIM11    IF YEAR IS 50 OR GREATER
          SX6    1R0         ZERO MARKS YEAR AS 20YY
 TIM11    BX1    X1+X6
          LX1    30
          EQ     TIM1        STORE RESULT
 
*         EXPAND *DATE* FROM * YY/MM/DD.* TO *YYYY/MM/DD*.
 
 TIM12    LX1    6
          BX1    X0*X1
          SX6    2R19
          NG     X1,TIM13    IF YEAR IS 50 OR GREATER
          SX6    2R20
 TIM13    BX1    X1+X6
          LX1    48
          EQ     TIM1        STORE RESULT
 
*         EXPAND *JDATE* FROM *YYDDD* TO *YYYYDDD*.
 
 TIM14    LX1    30
          BX1    X0*X1
          SX6    2R19
          NG     X1,TIM15    IF YEAR IS 50 OR GREATER
          SX6    2R20
 TIM15    BX1    X1+X6
          LX1    30
          EQ     TIM1        STORE RESULT
 WCL      SPACE  4,15
***       *WCL*.
*         PLACE PROGRAM ON TIMED RECALL.
*
*         ENTRY  (X7) = 0.
*
*T        18/  *WCL*,30/0,12/  DELAY
*         PLACE PROGRAM ON RECALL UNTIL *DELAY* MILLISECONDS
*         HAVE EXPIRED.
*
*         *DELAY* MUST BE IN THE RANGE OF 10D TO 4095D
*         MILLISECONDS.  A VALUE .LT. 10D DEFAULTS TO 10D AND
*         A VALUE .GT. 4095D DEFAULTS TO 4095D.  ONLY JOBS
*         WITH *SYOT* OR *SSJ=* ARE ALLOWED TO SPECIFY A VALUE
*         OF *DELAY* THAT IS LESS THAN THE SYSTEM DEFAULT.
 
 
 WCL      MX0    -18         VALIDATE *DELAY*
          BX3    -X0*X5
          SX1    4095D
          SX4    B1          CLEAR RA+1
          IX2    X2+X4
          EWX7   X2
          IX2    X3-X1       CHECK FOR *DELAY* ABOVE UPPER LIMIT
          MX0    -12
          NG     X2,WCL1     IF .LT. UPPER LIMIT
          SX3    X1          SET UPPER LIMIT
 WCL1     SX2    X3-10D      CHECK FOR *DELAY* .LT. LOWER LIMIT
          PL     X2,WCL2     IF .GT. LOWER LIMIT
          SX3    10D         SET LOWER LIMIT
 
*         VALIDATE CALLER IF *DELAY* .LT. SYSTEM DEFAULT.
 
 WCL2     SA1    MSCL        GET SYSTEM DEFAULT RECALL DELAY
          LX1    24
          BX1    -X0*X1
          IX2    X3-X1
          PL     X2,WCL3     IF *DELAY* .GE. SYSTEM DEFAULT
          SA2    B7+SEPW     GET SPECIAL ENTRY POINT WORD
          LX2    59-50
          NG     X2,WCL3     IF *SSJ=* JOB
          SA2    B7+JOTW     CHECK JOB ORIGIN TYPE
          AX2    12
          BX2    -X0*X2
          ERRNG  SYOT        CODE DEPENDS ON VALUE
          ZR     X2,WCL3     IF SYSTEM ORIGIN
          SX3    X1+         SET DELAY TO SYSTEM DEFAULT
 WCL3     SA1    RTCL        GET CURRENT TIME
          MX0    -36
          BX1    -X0*X1
          SX0    PTMF        SET RECALL CRITERION
          IX1    X1+X3
          LX0    36
          BX0    X0+X1
          EQ     SXR         SET *X* STATUS WITH RECALL CRITERION
 XJR      SPACE  4,15
***       *XJR*
*         PROCESS EXCHANGE JUMP REQUEST.
*
*         ENTRY
*
*T        18/  *XJR*,6/,12/  FN,6/,18/  ADDR
*         FN     FUNCTION CODE
*         ADDR   ADDRESS OF EXCHANGE PACKAGE.
*         FN     0 = START JOB WITH EXCHANGE PACKAGE AT *ADDR*.
*                1 = SAVE CURRENT PACKAGE AT *ADDR*.
 
 
 XJR      SB5    X5          EXTRACT ADDRESS
          LX5    -24
          SB6    B5+20B
          LE     B5,B1,CPE   IF ILLEGAL ADDRESS
          SA1    XJRA
          GE     B6,B4,CPE   IF ILLEGAL ADDRESS
          GE     B5,B4,CPE   IF ILLEGAL ADDRESS
          BX6    -X0*X5
          AX2    X6,B1
          NZ     X2,CPE      IF ILLEGAL FUNCTION
          SA3    B3+B1
          MX4    -36
          EWX7   X3          CLEAR (RA+1)
          ZR     X6,XJR2     IF FUNCTION 0
 
*         SAVE EXCHANGE PACKAGE FUNCTION 1.
 
          SA2    B2          FIRST WORD OF EXCHANGE PACKAGE
          UX1    X1          UNPACK REGISTER REPLACE BITS
          SX0    B2          CONTROL POINT ADDRESS
          SX6    B1
          IX3    X3-X6       RA
          SX7    B5          RELATIVE ADDRESS OF XP
          IX7    X3+X7       ABS ADDRESS
          IX7    X0-X7       DIFFERENCE OF MOVE
 XJR1     BX6    X2
          LX1    1
          IX2    X0-X7
          EWX6   X2          STORE EXCHANGE PACKAGE
          SX2    B1+
          IX0    X0+X2
          ERX2   X0          READ NEXT WORD TO MOVE
          PL     X1,XJR1     IF FULL WORD TO MOVE
          SB6    X1
          IX3    X0-X7
          ERX3   X3          READ EXCHANGE PACKAGE
          NG     B6,XJR3     IF END OF COPY
          BX2    -X4*X2      REPLACE REGISTERS
          BX3    X4*X3
          IX2    X3+X2
          EQ     XJR1        CONTINUE REGISTER COPY
 
*         STORE EXCHANGE PACKAGE - FUNCTION 0.
 
 XJR2     SA2    B3          RA
          SX0    B5          RELATIVE ADDRESS
          IX0    X0+X2       ABS ADDRESS
          SX2    B2          CONTROL POINT ADDRESS
          IX7    X0-X2       DIFFERENCE OF MOVE
          ERX2   X0          READ FIRST WORD
          EQ     XJR1        COPY EXCHANGE PACKAGE
 
 
 XJR3     SX7    B0
          MX0    -12
          EQ     MTRX        EXIT MONITOR
 
 
 XJRA     CON    37600200000000000002B  BIT SET FOR REGISTER REPLACE
          TITLE  PPU MONITOR REQUEST PROCESSOR.
**        PMN - PPU MONITOR REQUEST PROCESSOR.
*
*         ENTRY  (X0) = REQUEST.
*
*         ENTERED AT *PMN1* FROM */ISD/PMR*.
*         ENTERED AT *PMN4* FROM */ISD/PMR* AND */DCP/PCX*.
 
 
 PMN      RC     X5          READ CPU CLOCK IF 180 MACHINE
          SX7    B0+
          PX6    B0,X5       PRESET AS RA+1 PROCESS
          SA7    PPXL        CLEAR *PP EXCHANGE PENDING*
          SA6    CL+CMST+A0  SET CALL TYPE AND BASE TIME
          TNO    /CME/RTC,CME  UPDATE REAL TIME CLOCK FROM CPU CLOCK
 
*         ENTRY FROM /ISD/MNR.
 
 PMN1     NZ     X0,PMN2     IF NOT *CCPF* REQUEST
          ERRNZ  CCPF        CODE DEPENDS ON VALUE
 
*         PROCESS *CCPF* FUNCTION - RA+1 CALL DETECTED BY *MTR*.
 
          SA1    CPAL+A0     SET ACTIVE CP ADDRESS
          AX1    24
          SA2    B2+B1       CHECK ACTIVE RA
          AX2    36
          SB7    X1
          ZR     X2,MTRX     IF RA=0, EXIT
          TA5    20B,SP      SET DUMMY RA
          BX6    X2          RA ADDRESS
          SX7    B1
          IX7    X2+X7       RA+1 ADDRESS
          ERX5   X7          READ (RA+1)
          SA7    RA1         STORE RA+1
          SA6    A7-B1       STORE RA
          SB3    A7-B1       RA
          NZ     X5,CPR      PROCESS CPU REQUEST IF PRESENT
          EQ     MTRX        EXIT
 
*         OTHER REQUESTS.
 
 PMN2     SX1    X0-MXPF
          PL     X1,PMN4     IF PPU REQUEST
          SA3    TPMN-1+X0   SET REQUEST PROCESSOR
          SX7    X0+2000B    SET FUNCTION
          LX7    48
          BX6    X7+X5
          SA6    CL+CMST+A0  SET FUNCTION AND BASE TIME
          MX7    24
          BX2    -X7*X0
          AX2    24
          SB6    X3
          SB7    X2          SET CP ADDRESS/PARAMETER
          BX7    X7-X7
 
*         EXIT TO PROCESSOR WITH-
*         (X0) = REQUEST.
*         (X2) = CP ADDRESS/PARAMETER.
*         (X7) = 0.
*         (B6) = PROCESSOR ADDRESS.
*         (B7) = CP ADDRESS/PARAMETER.
 
          TJP    (/PROBE/PMN,PROBE,B6)  PROCESS REQUEST
 
*         PROCESS PPU REQUEST.
*         ENTRY FROM */ISD/MNR* AND */DCP/PCX*.
*         (X0) = OUTPUT REGISTER ADDRESS.
*         (X5) = MONITOR MODE ENTRY TIME IF 180 MACHINE.
 
 PMN4     BX3    X5          SET START TIME FOR *PPR*
          SA5    X0+         READ OUTPUT REGISTER
          UX1,B4 X5          UNPACK FUNCTION CODE AND PARAMETERS
          SB4    B4+1777B
          EQ     PPR0.1      PROCESS PPU REQUEST
 CSWF     SPACE  4,10
**        CSWF - SWITCH CPU.
*
*         ENTRY
*T, X0    42/,18/  CSWF
*
*         EXIT   TO *BNJ1* IF CPU TO BE SWITCHED.
 
 
          PMN    CSWF
 
          SA1    TSCL+A0
          SA2    RTCL
          SA3    CSWL+A0
          MX6    -36
          BX1    -X6*X1
          BX2    -X6*X2
          NG     X3,BNJ1     IF CPU SWITCH REQUESTED
          IX2    X2-X1
          PL     X2,BNJ1     IF RECALL SLICE EXPIRED
          EQ     MTRX        EXIT
 ARTF     SPACE  4
**        ARTF - ADVANCE RUNNING TIME.
*
*         ENTRY
*T X0     42/,18/  ARTF
*
*         EXIT   NONE.
 
 
          PMN    ARTF
 
 ART      SB3    ART1        SET *CPT* RETURN ADDRESS
          SB6    B0+
          TJP    (/NVE/CPT,NVE,/CME/CPT,CME,/MONITOR/CP76,CP176,/MONITOR
,/CPT)
 
 ART1     SA3    RTCL
          SA2    JSCL
          MX7    -24
          SB4    MTRX
          AX3    36
          BX2    -X7*X2
          SB6    B2
          SB7    X1+
          IX4    X3-X2
          AX1    18
          NG     X4,ART3     IF NOT TIME TO CALL *1SJ*
          SB4    SJS
 ART3     ZR     X1,CJS      IF USER JOB EXECUTING
          JP     B4
 CSTF     SPACE  4,10
**        CSLF - CHECK SUBCP TIME LIMIT.
*
*         ENTRY
*T,X0     42/,18/  CSLF.
*
*         EXIT   NONE.
 
 
          PMN    CSLF
 
          SA1    ACPL+A0
          MX7    -36
          BX1    -X7*X1
          ZR     X1,MTRX     IF NO SUBCP
          SA3    RTCL
          BX3    -X7*X3
          IX3    X3-X1
          NG     X3,MTRX     IF NO TIME LIMIT
          SA1    CPAL+A0     SET ACTIVE CP ADDRESS
          SX7    TLET        TIME LIMIT
          AX1    24
          SB7    X1          SET CPA ADDRESS
          EQ     SEF         SET ERROR FLAG
 EPRF     SPACE  4,10
**        EPRF - ENTER PROGRAM MODE REQUEST.
*
*         ENTRY
*T, X0    24/,12/ PR,6/,18/ EPRF
*         PR     PROGRAM MODE REQUEST NUMBER AS DEFINED IN COMSMTR.
*
*         EXIT   REQUEST BIT SET IN *PR*.
 
 
          PMN    EPRF
 
          TZR    B7,(/MONITOR/EPR1,SMXF,/MONITOR/EPR3)  IF *MSTF*
          ERRNZ  MSTF
          PX0    X7          POSITION REQUEST BIT
          AX0    X0,B7
          SB3    B7-MECF
          NZ     B3,EPR      IF NOT *MECF*
          TSX6   (EEMC-1+300B,ESM170,EEMC-1+100B)
          TX2    MECS        SET MAXIMUM MEMORY
          TLX2   (6,ESM170,0)
          TX1    MECNF
          BX2    X1+X2
          LX2    3
          TEQ    (/MONITOR/EPR2,SMXF,/MONITOR/EPR3)  PROCESS *MECF*
 
*         MODIFY STORAGE MOVE EXCHANGE PACKAGE IF EXTERNAL
*         USER ECS IS DEFINED ON AN 865/875 MAINFRAME.
*         FOR *MSTF*, CM COPY FLAG SET AND FLE = MACHINE CM FL.
*         FOR *MECF*, CM COPY FLAG CLEAR AND FLE = MACHINE ECS FL.
 
 EPR1     TSX6   (EEMC-1+700B,ESM170,EEMC-1+500B)
          TX2    MCMS        SET MAXIMUM MEMORY
 EPR2     TLX2   (36-18,ESM170,36+6-18)
          SX1    SMIN        SET XP A5 = *SMIN*
          LX6    48
          BX7    X1+X2
          SA6    SMPXP+3
          LX7    18
          SA7    SMPXP+5
 EPR3     SB3    EPR4        SET RETURN ADDRESS
          SX7    B7+1        SAVE REQUEST
          SA7    SMPR
          EQ     SCA         CONVERT CP/PCP ADDRESS
 
 EPR4     SA2    A2          REREAD *SMRL*
          SX6    B7
          SA6    SMPXP+7     SET CP/PCP ADDRESS IN MOVE XP
          BX7    X2
          MX0    -12
          AX2    24          POSITION BLOCK MOVE STATUS
          SX5    X7
          BX6    -X0*X2      EXTRACT HOLE POINT NUMBER
          AX7    48
          SA6    TSMA
          ZR     X6,EPR6     IF NOT FIELD LENGTH SWAP
          MX7    -24
          AX5    12
          LX6    1
          TB5    X5,MCT      MCT BASE ADDRESS
          SA3    B5+X6       READ HOLE POINT MCT ENTRY
          SX6    B1
          BX7    -X7*X3      HOLE
          TA3    DMMS,SDA
          SA7    TSMB        SAVE PRE-MOVE HOLE SIZE
          SB3    EPR5        SET *SCA* RETURN ADDRESS
          IX6    X3+X6       INCREMENT DIRECT MOVE COUNT
          LX5    1
          ERRNZ  FLSW+2-ECSW  CODE DEPENDS ON VALUE
          SA6    A3
          SX2    X2
          SB6    X5+FLSW     SET FL CONTROL WORD ADDRESS
          SA3    B6+B7
          AX3    12          POSITION RA/RAX
          SX5    X3
          EQ     SCP         SET CP/PCP ADDRESS OF HOLE
 
 EPR5     SA4    B6+B7       CALCULATE FWA OF HOLE
          AX3    48-12
          BX1    -X0*X4      EXTRACT FL/FLX
          AX4    12
          IX3    X5-X3       RA/RAX - NFL OF REQUESTOR
          SX4    X4
          IX4    X4+X1       HOLE BEGINS AT RA/RAX + FL/FLX
          IX7    X4-X3
 EPR6     SA7    SMIN        SAVE MOVE INCREMENT
          TB7    SCA
          SB6    SMPXP       STORAGE MOVE EXCHANGE PACKAGE
          SB3    MTRX        *RCC* RETURN ADDRESS
          EQ     RCC         RECALL CPU
 RCLF     SPACE  4,15
**        RCLF - RECALL CPU FOR SPECIFIED CONTROL POINT.
*
*         NOTE   ANY ADDITIONAL PROGRAMS IN *X* STATUS RECALL WHOSE
*                TIME HAS EXPIRED AND WHICH DIRECTLY FOLLOW THE
*                REQUESTED CONTROL POINT WILL ALSO BE RECALLED.
*
*         ENTRY
*T X0     24/,12/ CPA,6/,18/RCLF
*                CPA = CONTROL POINT ADDRESS.
 
 
          PMN    RCLF
 
 
 RCL      SA1    B7+CWQW     CHECK RECALL STATUS
          SA5    B7+CRCW     GET *X* STATUS *RQ* LINK
          SB3    RCL1        SET *RCC* RETURN ADDRESS
          SB6    B7          SET EXCHANGE PACKAGE ADDRESS
          LX1    59-46
          PL     X1,RCC      IF TO RECALL JOB
          EQ     MTRX        EXIT
 
 RCL1     MX0    -7
          BX1    -X0*X5
          SA3    RTCL
          SX2    X1-CRCW
          NZ     X2,MTRX     IF NO LINK TO *RQ* ENTRY
          SA4    MSCL
          MX0    -12
          LX4    12
          BX1    -X0*X5      EXTRACT ADDRESS OF NEXT RECALL ENTRY
          BX6    -X0*X4      EXTRACT RECALL DELAY REDUCTION LIMIT
          SX4    7600B
          SA2    X1
          MX0    -36
          BX3    -X0*X3      EXTRACT REAL TIME
          AX2    12
          IX3    X3+X6       REAL TIME + DELAY REDUCTION LIMIT
          BX6    -X0*X2      EXTRACT RECALL TIME
          BX1    X4*X5       EXTRACT CP ADDRESS
          IX6    X3-X6       ADJUSTED REAL TIME - RECALL TIME
          NG     X6,MTRX     IF TIME NOT EXPIRED
          SB7    X1+
          EQ     RCL         LOOP TO RECALL NEXT JOB
 MFLF     SPACE  4,15
**        MFLF - MODIFY FL.
*
*         ENTRY
*T, X0    12/ MI, 6/ FL, 6/ ST, 12/ PN, 12/, 12/ MFLF
*         MI     MEMORY INCREMENT.
*         FL     FL SELECTION.
*                0  = NFL CHANGE.
*                4  = FL CHANGE.
*                10 = MACHINE FL CHANGE (*MABL*, *ACML*, LAST CP MCT).
*                11 = MACHINE FL CHANGE (LAST CP MCT ONLY)
*         ST     STORAGE MEDIUM.
*                0 = CM TYPE.
*                1 = XM TYPE.
*         PN     CP/PCP NUMBER.
 
 
          PMN    MFLF
 
          BX6    X0
          LX6    59-39
          NG     X6,MFL3     IF MACHINE FL CHANGE
          SB4    MFL1        SET RETURN FROM *CPA*
          SX3    77B
          SB3    CPA         SET RETURN FROM *SCP*
          EQ     SCP         SET CP/PCP ADDRESS
 
 MFL1     AX2    36          POSITION PARAMETERS
          AX0    48
          SA1    ACML        GET AVAILABLE FL WORD
          SB5    B1+
          BX7    -X0
          BX3    X3*X2       EXTRACT STORAGE MEDIUM
          LX7    12          POSITION INCREMENT FOR XM UPDATE
          NZ     X3,MFL2     IF XM
          LX7    24          POSITION INCREMENT FOR CM UPDATE
 MFL2     IX7    X1+X7       UPDATE AVAILABLE CM/XM
          SA7    A1
          TNZ    X3,(/UEC/MFX,UEC,/MONITOR/HNG)  IF XM
          MX5    -12
          BX1    -X5*X2      EXTRACT TYPE OF FL
          LX0    6
          AX1    6
          NZ     X1,SFL1     IF NOT NFL CHANGE
          SA2    B7+FLSW
          LX0    48-6        POSITION INCREMENT FOR *FLSW*
          SA1    A2+B1
          IX7    X2+X0       ADJUST NFL
          LX0    12+12
          TA3    X6,MCT      READ MCT ENTRY
          IX1    X1+X0
          AX3    48-1        INDEX TO BACKWARD LINK
          LX0    12
          IX6    X1-X0       ADJUST RA - NFL
          SA7    A2
          LX0    -24         POSITION INCREMENT FOR MCT
          AX7    12
          SA6    A1          UPDATE *FLSW* + 1
          TA3    X3,MCT
          SB4    MTRX        SET RETURN FROM *CRA*
          IX6    X3-X0       ADJUST UNASSIGNED CM BELOW CP/PCP
          SA6    A3
          NG     X0,CRA6     IF NFL DECREASE
          MX3    -24
          BX3    -X3*X7      RA/100
          BX1    -X5*X0      INCREMENT / 100
          AX7    36
          LX1    6           INCREMENT (AMOUNT TO CLEAR)
          BX2    -X5*X7      NFL/100
          IX2    X3-X2
          LX2    6           FWA OF NFL
          SB3    CRA6        SET RETURN FROM *CSM*
          TEQ    (/CME/CSM,CME,/0CME/CSM)  CLEAR STORAGE
 
*         PROCESS CHANGE IN MACHINE FL (SPECIAL *VER* REQUEST).
 
 MFL3     BX2    X0          GET MEMORY INCREMENT/DECREMENT
          AX2    48
          BX2    -X2
          LX6    59-36-59+39
          NG     X6,MFL4     IF *MABL*/*ACML* NOT TO BE UPDATED
          SA1    MABL        ADJUST MACHINE FL
          LX2    12
          IX6    X1+X2
          SA6    A1+
          LX2    24
          SA1    ACML        ADJUST AVAILABLE CM
          IX6    X1+X2
          SA6    A1+
          SX2    B0+         CLEAR UNASSIGNED MEMORY AT LAST CP
 MFL4     TX6    -1,SC       GET MCT INDEX FOR LAST CP
          LX6    1
          TA1    X6,MCT      CHANGE UNASSIGNED MEMORY VALUE FOR LAST CP
          MX6    48
          BX1    X6*X1
          BX2    -X6*X2
          BX6    X1+X2
          SA6    A1+
          EQ     MTRX        EXIT
 MRAF     SPACE  4,10
**        MRAF - MODIFY RA.
*
*         ENTRY
*T, X0    12/ MI, 12/ ST, 12/ PN, 12/, 12/ MRAF
*         MI     MEMORY INCREMENT.
*         ST     STORAGE MEDIUM.
*                0 = CM TYPE
*                1 = XM TYPE
*         PN     CP/PCP NUMBER.
 
 
          PMN    MRAF
 
          SB3    MRA1
          EQ     SCP         SET CP/PCP ADDRESS
 
 MRA1     AX0    36          POSITION PARAMETERS
          MX3    -12
          SB4    MTRX        SET EXIT ADDRESS
          BX3    -X3*X0
          AX0    12          POSITION INCREMENT
          TNZ    X3,(/UEC/MRX,UEC,/MONITOR/HNG)  IF XM REQUEST
          SA2    B7+FLSW     READ FL CONTROL WORD
          BX5    X0
          SA1    B7+B1       READ EXCHANGE PACKAGE
          LX2    -RSHF
          IX7    X2+X0       UPDATE RA
          MX6    -RMSK
          BX6    -X6*X7      NEW RA
          MX3    -36
          LX6    36+6        POSITION NEW RA FOR XP
          BX1    -X3*X1
          LX7    RSHF        REPOSITION *FLSW*
          SA3    A2+B1
          LX5    24          POSITION INCREMENT
          BX6    X6+X1
          SB5    B0
 +        SA7    A2          UPDATE CONTROL POINT AREA
          IX7    X3+X5
          SA6    A1          MODIFY EXCHANGE PACKAGE
          SA7    A3
          EQ     UMT1        UPDATE MEMORY CONTROL TABLE
 MSCF     SPACE  4
**        MSCF - MONITOR STEP CONTROL.
*
*         ENTRY
*T, X0    30/,12/  P,18/  MSCF
*
*         P      PARAMETER.
*                O = SET MONITOR STEP.
*                1 = CLEAR MONITOR STEP.
 
          PMN    MSCF
 
          SA1    MSCA+B7
          GT     B7,B1,*     IF NOT VALID PARAMETER
          NO
          BX6    X1
          SA6    PPR
          EQ     MTRX        EXIT
 
 MSCA     EQ     MSC2        DISABLE PPU *MXN* PROCESSOR
 
 MSC1     SA5    A5          ENABLE PPU *MXN* PROCESSOR
          RC     X3
          SX6    B0
          UX1,B4 X5
          EQ     PPR0        PROCESS REQUEST
 
*         ENTERED FROM *PPR* WHEN STEP IS SET.
 
 MSC2     TX7    A5,-SP
          PL     X7,MSC1     IF PSEUDO PP
          SA5    A5          INDICATE THAT CPU EXCHANGE HAS OCCURRED
          SX1    B1
          LX1    57
          BX7    X1+X5
          SA7    A5
          EQ     MTRX        DONT PROCESS REQUEST
 PRQF     SPACE  4,10
**        PRQF - PROCESS RECALL REQUEST.
*
*         ENTRY
*T, X0    12/,12/,12/  AD,6/,18/  PRQF
*         AD     ADDRESS OF REQUEST TO RECALL.
 
 
          PMN    PRQF
 
          SA1    RQ+TAQR
          AX1    18
          MX2    -12
          SX7    X1+
          SA3    B7+
 PRQ1     SA1    X7          FIND NEXT ENTRY IN QUEUE
          BX7    -X2*X1
          SB6    X7+
          ZR     X7,MTRX     IF ENTRY NOT IN QUEUE
          NE     B6,B7,PRQ1  IF NOT THIS ENTRY
          SA4    B7+RECW-RCCW  READ RECALL REQUEST
          AX0    24+7        SET CP ADDRESS
          MX6    -5
          BX7    X2*X1       REPLACE LINK IN ENTRY POINTING TO RECALL
          BX0    -X6*X0
          LX0    7
          BX3    -X2*X3
          BX7    X7+X3
          SB7    X0
          SA7    A1+
          SA1    B7+STSW     ADD FREE ENTRY TO CONTROL POINT
          SA3    B6+         CHECK RECALL CRITERION
          SX0    A4-B7
          LX3    12
          BX3    -X2*X3
          MX2    -4
          SX3    X3-PTRF
          SX0    X0-RECW+1-20B
          NZ     X3,PRQ2     IF ROLLOUT NOT INHIBITED
          SX0    X0-400B
 PRQ2     BX7    -X2*X1
          BX1    X2*X1       CLEAR OLD NEXT FREE ENTRY
          MX6    0           CLEAR RECALLED REQUEST
          SA7    B6
          SA6    A4+
          SA3    A4+REPW-RECW  GET PARAMETER WORD
          SA6    A3
          IX7    X1+X0
          BX6    X4
          SA7    A1          UPDATE STSW
          BX7    X3
          LX4    18
          SA7    APQA        SET PARAMETER WORD
          SX3    X4-3R1AJ
          SB3    MTRX        *APQ* RETURN ADDRESS
          ZR     X3,PRQ3     IF *1AJ*
          SX4    X4-3RCIO
          SB4    B0+         SET LIBRARY TO BE SEARCHED
          TA5    1,FP        SET *MTR*-S OUTPUT REGISTER ADDRESS
          NZ     X4,APQ      IF NOT *CIO*
          TA5    10B,SP      SET FAKE RA+1
          SA6    /CPUCIO/IR
          SA7    /CPUCIO/MB
          SA1    SMRL        CHECK IF CONTROL POINT MOVING
          MX4    -12
          BX3    -X4*X1
          LX3    7
          SB5    X3
          NE     B5,B7,/CPUCIO/CPC  IF CONTROL POINT NOT MOVING
          SB5    MVPR        MOVE IN PROGRESS
          EQ     /CPUCIO/RCR REQUEUE *CIO* CALL
 
*         CHECK FOR NO ACTIVITY IF *1AJ* IS COMING OUT OF RECALL.
 
 PRQ3     SA1    B7+STSW     GET CONTROL POINT ACTIVITY
          SA7    AQRA        SAVE PARAMETER WORD IF REQUEUE NEEDED
          MX0    -12
          LX1    12
          BX7    -X0*X1      PP AND CPU ACTIVITY
          LX1    59-24-12
          NG     X1,PRQ4     IF ROLLOUT SET
          SA2    B7+JCIW     GET DIS FLAG
          SX0    B1
          LX2    0-21
          BX2    X0*X2
          IX7    X7-X2
 PRQ4     LX1    24-59-8
          MX0    -4
          BX1    -X0*X1      PP-S IN RECALL
          IX7    X1+X7
          NZ     X7,REC2     IF ACTIVITY, RECALL REQUEST
          SA2    B7+TFSW     GET JOB EJT ORDINAL
          MX1    -12
          LX2    12
          BX2    -X1*X2
          CX3    X2,EJT      CONVERT EJT ORDINAL TO OFFSET
+         ZR     X2,*        IF NO EJT ORDINAL
          TA2    X3+JSNE,EJT GET EJT ENTRY
          SX1    B1
          BX3    X1*X2       CHECK JOB INTERLOCK
          NZ     X3,REC2     IF JOB INTERLOCK ALREADY SET
          BX7    X2+X1       SET JOB INTERLOCK
          LX1    6-0
          BX7    X7+X1       SET JOB ADVANCE FLAG
          SA7    A2
          R=     B4,LA1AJ    SET *1AJ* LOAD PARAMETERS
          EQ     APQ         ASSIGN *1AJ*
 TCSF     SPACE  4,10
**        TCSF - SWITCH CPU ON TIMESLICE.
*
*         ENTRY
*T, X0    42/,18/  TCSF
*
*         EXIT   TO *BNJ1* IF CPU TO BE SWITCHED.
 
 
          PMN    TCSF,.CSWF
 PCXF     SPACE  4
**        PCXF - PROCESS CPU EXCHANGE REQUEST.
*
*         ENTRY
*T X0     42/,18/  PCXF
*
*         EXIT   NONE.
 
 
          PMN    PCXF,(/DCP/PCX,DCP,/MONITOR/HNG)
 ARMF     SPACE  4
**        ARMF - ADVANCE RUNNING TIME AND MULTI-MAINFRAME PROCESSING.
*         *ARMF* IS CALLED ONCE EVERY SECOND BY PPU MONITOR
*         TO DO THE FOLLOWING.
*         1)     STATUS FLAG REGISTER BITS.
*         2)     WRITE REAL TIME CLOCK TO ECS.
*         3)     DETERMINE STATUS OF OTHER MAINFRAMES BY INTEROGATING
*                THEIR ECS CLOCKS. (DONE EVERY 2 SECONDS)
*
*         ENTRY
*T X0     24/,12/  S,6/,18/  ARMF
*         (B7) = S = 0 IF MAINFRAMES NOT TO BE STATUSED.
*
*         EXIT
*                EXITS TO ART.
 
 
          PMN    ARMF,(/MMF/ARM,MMF,/MONITOR/HNG)
 UCCF     SPACE  4
**        UCCF - UPDATE CTI CLOCK.
*
*         ENTRY
*T X0     42/,18/  UCCF
 
 
          PMN    UCCF
 
*         ENTER HERE FROM *ADTF* PROCESSOR.
 
 UCC1     SA5    INWL        CHECK CTI CLOCK UPDATE ACTIVE FLAG
          MX2    1
          LX5    59-3
          NG     X5,MTRX     IF *1MA* ALREADY CALLED
 
*         SET CTI CLOCK UPDATE ACTIVE FLAG AND CALL *1MA*.
 
          TB7    SCA         SET SYSTEM CONTROL POINT
          BX7    X2+X5
          SB3    MTRX        SET EXIT ADDRESS
          LX7    3-59
          SA1    UCCA        SET PP CALL
          BX6    X1
          SA7    A5          SET CTI CLOCK UPDATE ACTIVE FLAG
          SB4    LA1MA       SET INDEX INTO *TAPQ* TABLE
          EQ     APQ         ASSIGN PP
 
 UCCA     VFD    18/0L1MA,6/0,12/6,24/0
 CRAF     SPACE  4,10
**        CRAF - CHANGE RA.
*
*         ENTRY
*T, X0    12/ HN, 12/ ST, 12/ PN, 6/ PF, 18/ CRAF
*         HN     HOLE POINT NUMBER.
*         ST     STORAGE MEDIUM.
*                0 = CM TYPE
*                1 = XM TYPE
*         PN     CONTROL POINT NUMBER.
*         PF     = UPPER 6 BITS OF *RSTM* FLAG BYTE.
 
 
          PMN    CRAF
 
          SB6    B7+0        SAVE CP/PCP NUMBER
          SB3    CRA1
          EQ     SCP         SET CP/PCP ADDRESS
 
 CRA1     AX0    22-0
          MX7    -2
          BX7    -X7*X0      PSEUDO-ROLLIN, PSEUDO-ROLLOUT FLAGS
          AX0    36-1-22+0   POSITION STORAGE TYPE
          ERRNZ  FLSW+2-ECSW CODE DEPENDS ON VALUE
          MX5    -12
          BX4    -X5*X0
          SB5    B7+
          AX0    12+1
          SX4    X4+FLSW
          BX2    X0          SET CP/PCP NUMBER FOR *SCP*
          SB3    CRA2        *SCP* EXIT ADDRESS
          EQ     SCP         GET CPA/PCPA ADDRESS
 
 CRA2     SA3    B7+X4       READ FL CONTROL WORD
          BX2    -X5*X3      FL
          BX0    X6
          LX3    -12
          SB4    MTRX        SET EXIT ADDRESS
          BX6    X3
          SX1    X3
          ZR     X7,CRA3     IF JOB INITIATION/ROLLIN FROM MASS STORAGE
          LX6    12
          LX3    -48+12
          SA6    B5+X4       MOVE FL CONTROL WORD
          BX2    -X5*X3      NFL (0 IF RAE UPDATE)
          SA3    A3+1        SAVE *FLSW*+1
          SB3    A6+1
          SB5    B7
          BX2    -X2         -NFL (-0 IF RAE UPDATE)
 CRA3     IX6    X1+X2       ADJUST RA
          LX6    12
          SA6    B5+X4
          LX4    59-2
          ERRNZ  ECSW-25B    CODE DEPENDS ON VALUE
          ERRNZ  FLSW-23B    CODE DEPENDS ON VALUE
          SX1    4000B
          NG     X4,CRA4     IF EM REQUEST
          BX6    X6+X1       BUILD *FLSW*+1
          LX6    12
          SA6    A6+1
          ZR     X7,CRA4     IF JOB INITIATION/ROLLIN FROM MASS STORAGE
          BX7    X3
          SA7    B3          MOVE OTHER *FLSW*+1
 CRA4     AX4    59          SIGN EXTEND MEMORY TYPE FLAG
          SX3    1
          MX5    12          SET LINK BYTE MASK
          BX6    X3*X4
          SX2    B6
          TB5    X6,MCT
 
*         STEP 1.  MCT ENTRY FOR CP/PCP BELOW HOLE - CHANGE FORWARD
*                  LINK TO REQUESTING CP AND CLEAR UNASSIGNED MEMORY.
 
          SA3    X0+B5       GET MCT ENTRY
          MX7    -24
          LX5    -12
          BX6    X7*X3       REMOVE UNASSIGNED MEMORY
 CRA5     LX2    36
          BX6    -X5*X6
          BX6    X6+X2       CHANGE FORWARD LINK
          SA6    A3
 
*         STEP 2.  MCT ENTRY FOR CP/PCP ABOVE HOLE - CHANGE BACKWARD
*                  LINK TO REQUESTING CP.
 
          BX4    X5*X3       OLD FORWARD LINK
          AX4    36-1
          SA1    X4+B5       GET MCT ENTRY
          LX5    12
          BX1    -X5*X1      REMOVE BACKWARD LINK
          LX2    12
          BX6    X2+X1       BACKWARD LINK TO REQUESTING CP
          SA6    A1
 
*         STEP 3.  MCT ENTRY FOR REQUESTING CP - CHANGE BACKWARD LINK
*                  TO CP/PCP OF STEP 1, CHANGE FORWARD LINK TO CP/PCP
*                  OF STEP 2 AND SET UNASSIGNED MEMORY FROM HOLE.
 
          LX2    12+1
          BX3    -X7*X3      UNASSIGNED MEMORY FROM HOLE
          LX0    48-1
          BX3    X0+X3       CHANGE BACKWARD LINK
          SA2    X2+B5
          LX4    36-1
          BX6    X3+X4       CHANGE FORWARD LINK
          SA6    A2
 
*         STEP 4.  MCT ENTRY BELOW REQUESTING CP - CHANGE FORWARD
*                  LINK TO CP ABOVE REQUESTOR AND ACCUMULATE ANY
*                  UNASSIGNED MEMORY PREVIOUSLY ABOVE REQUESTOR.
 
          BX3    X5*X2       EXTRACT REQUESTOR-S BACKWARD LINK
          AX3    48-1
          BX1    -X5*X2      REMOVE BACKWARD LINK
          SA4    X3+B5
          LX5    -12         POSITION MASK
          BX4    -X5*X4
          IX6    X4+X1       ADD FORWARD LINK AND UNASSIGNED MEMORY
          SA6    A4
 
*         STEP 5.  MCT ENTRY ABOVE REQUESTING CP - CHANGE BACKWARD
*                  LINK TO CP BELOW REQUESTOR.
 
          BX2    X5*X2       EXTRACT REQUESTOR-S FORWARD LINK
          AX2    36-1
          LX5    12          REPOSITION MASK
          SA4    X2+B5
          BX4    -X5*X4      REMOVE OLD LINK
          LX3    48-1
          BX6    X3+X4       SET NEW BACKWARD LINK
          SA6    A4
 CRA6     SX7    0           INDICATE FUNCTION COMPLETE
          SA7    SMRL
          JP     B4          EXIT
 ADTF     SPACE  4,10
**        ADTF - ADVANCE DATE AND TIME.
*
*         ENTRY
*T, X0    12/  BA,24/,12/ 0,12/  ADTF
*
*                BA = 0 IF CALLED TO ADVANCE DATE AND TIME.
*                   = BUFFER ADDRESS IF CALLED TO ENTER DATE AND TIME.
*
*         EXIT   NONE.
 
 
          PMN    ADTF
 
          MX5    -12
          LX0    -48
          BX0    -X5*X0      BUFFER ADDRESS IF ENTER DATE/TIME CALL
          SA1    X0
          ZR     X0,ADT2     IF CALLED TO ADVANCE DATE/TIME
 
*         ENTER DATE AND TIME.
 
          SA2    A1+B1
          BX6    X1
          BX7    X2
          SA6    JDAL        UPDATE *JDAL*
          ERRNZ  PDTL-JDAL-1 CODE DEPENDS ON VALUES
          SA7    A6+B1       UPDATE *PDTL*
          SA1    A2+B1
          BX6    X1
          SA2    A1+B1
          ERRNZ  TIML-PDTL-1 CODE DEPENDS ON VALUES
          SA6    A7+B1       UPDATE *TIML*
          BX7    X2
          ERRNZ  DTEL-TIML-1 CODE DEPENDS ON VALUES
          SA7    A6+B1       UPDATE *DTEL*
          SA1    A2+B1
          LX1    -48
          BX6    -X5*X1
          ZR     X6,ADT1     IF NO DAY LIMIT UPDATE REQUIRED
          SA6    ADTA        UPDATE DAY LIMIT
 ADT1     BX7    X7-X7
          SA1    MABL
          LX1    59-47
          SA7    X0          CLEAR *DSD* INTERLOCK
          NG     X1,MTRX     IF NOT CYBER 180
          LX1    59-42-59+47
          PL     X1,MTRX     IF NOT CYBER 180
          EQ     UCC1        CHECK FOR CTI CLOCK UPDATE REQUIRED
 
*         ADVANCE DATE AND TIME IN *PDTL*.
 
 ADT2     SA1    JDAL
          ERRNZ  PDTL-JDAL-1 CODE DEPENDS ON VALUES
          SA2    A1+B1       READ *PDTL*
          LX2    -6          LEAVE SECONDS UNCHANGED
          MX7    -6
          BX2    X7*X2       RESET MINUTES
          LX2    -6
          SX0    B1
          SB4    6
          SB3    12
          IX2    X2+X0       ADVANCE HOURS
          BX4    -X7*X2
          SX4    X4-24D
          NG     X4,ADT6     IF NOT END OF DAY
          SA4    ADTA
          BX2    X7*X2       RESET HOUR = 0
          SB3    B3+B4
          LX2    -18+12
          IX2    X2+X0       ADVANCE DAY IN *PDTL*
          BX6    -X7*X2
          BX6    X4-X6
          NZ     X6,ADT3     IF NOT END OF MONTH
          BX2    X7*X2
          IX2    X2+X0       RESET DAY = 1
          SB3    B3+B4
          LX2    -24+18
          IX2    X2+X0       ADVANCE MONTH IN *PDTL*
          BX4    -X7*X2
          SA3    X4+TDLM     SET NEW DAY LIMIT
          SX6    X3+1
          SA6    A4+
          SX4    X4-13D
          NG     X4,ADT3     IF NOT END OF YEAR
          BX2    X7*X2
          IX2    X2+X0       RESET MONTH = 1
          SB3    B3+6
          LX2    -30+24
          IX2    X2+X0       ADVANCE YEAR
          SX6    28          RESET FEBRUARY *TDLM* ENTRY
          MX4    -18
          BX1    X4*X1
          SX4    3R000
          BX1    X1+X4       RESET JULIAN DAY
          SX4    3
          BX4    X4*X2
          SX4    X4-2        CORRECT PACKED DATE TO NEAREST LEAP YEAR
          NZ     X4,ADT2.1   IF NOT LEAP YEAR
          SX6    X6+B1       ADJUST FOR LEAP YEAR
 ADT2.1   SA6    TDLM+2
 
*         ADVANCE JULIAN DAY.
 
 ADT3     SX6    1R0
          SB5    B0+
 ADT4     IX1    X1+X0
          BX4    -X7*X1
          SX4    X4-45B
          NG     X4,ADT5     IF NOT DIGIT OVERFLOW
          BX1    X7*X1
          BX1    X1+X6       RESET DIGIT TO DISPLAY CODE 0
          LX1    -6
          SB5    B5+B4
          EQ     ADT4        INCREMENT NEXT DIGIT
 
 ADT5     LX1    X1,B5       RESTORE *JDAL* POSITION
          MX4    -18
          BX4    -X4*X1
          SX4    X4-3R001
          NZ     X4,ADT6     IF NO NEED TO ADVANCE JULIAN YEAR
          SB5    B5-18
          PL     B5,ADT6     IF JULIAN YEAR ALREADY ADVANCED
          LX1    -18
          SB5    18
          EQ     ADT4        ADVANCE YEAR
 
*         CONSTRUCT *TIML*.
 
 ADT6     LX6    X2,B3       RESTORE *PDTL* POSITION
          SA6    A2          UPDATE *PDTL*
          BX4    X6
          BX6    X1
          SA6    A1+         UPDATE *JDAL*
          LX4    -12
          BX3    -X7*X4      HOUR FROM *PDTL*
          ERRNZ  TIML-PDTL-1 CODE DEPENDS ON VALUES
          SA2    A2+B1       READ *TIML*
          SX1    2R00
          LX2    -24
          BX2    X5*X2       RESET MINUTES IN *TIML*
          BX2    X2+X1
          LX2    -42+24
          BX2    X5*X2       CLEAR HOUR FIELD OF *TIML*
          SB3    -1          CONVERT OCTAL HOUR TO DECIMAL DISPLAY CODE
          SB5    X3+         OCTAL HOUR
 ADT7     SB4    B5
          SB3    B3+B1
          SB5    B4-10D
          PL     B5,ADT7     IF CONVERSION TO DECIMAL INCOMPLETE
          SX6    B3          LEFT DIGIT VALUE
          LX6    6
          SX3    B4+         RIGHT DIGIT VALUE
          BX3    X6+X3       COMBINE DIGIT VALUES
          IX3    X3+X1       CONVERT TO DISPLAY CODE
          BX6    X2+X3       MERGE DISPLAY CODE HOURS INTO *TIML*
          LX6    42
          SA6    A2+         UPDATE *TIML*
 
*         CONSTRUCT *DTEL*.
 
          ERRNZ  DTEL-TIML-1 CODE DEPENDS ON VALUES
          SA2    A6+B1       READ *DTEL*
          LX2    12
          SB6    3
 ADT8     LX2    -18
          BX2    X5*X2       CLEAR 12 BIT FIELD
          LX4    -6          POSITION *PDTL*
          BX3    -X7*X4      *PDTL* 6 BIT VALUE
          NE     B6,B1,ADT9  IF NOT CONVERTING YEAR
          SX3    X3+70D      BIAS YEAR BY 1970
 ADT9     SB3    -1          CONVERT OCTAL VALUE TO DECIMAL DISPLAY
          SB5    X3+         OCTAL VALUE
 ADT10    SB4    B5
          SB3    B3+B1
          SB5    B4-10D
          PL     B5,ADT10    IF CONVERSION TO DECIMAL INCOMPLETE
          SX6    B3-10D
          ZR     X6,ADT11    IF CENTURY ROLLOVER
          SX6    B3          LEFT DIGIT VALUE
          LX6    6
 ADT11    SX3    B4          RIGHT DIGIT VALUE
          BX3    X6+X3       COMBINE DIGIT VALUES
          IX3    X3+X1       CONVERT DIGITS TO DISPLAY CODE
          BX2    X2+X3       MERGE DATA INTO *DTEL*
          SB6    B6-B1
          NZ     B6,ADT8     IF NOT DONE BUILDING *DTEL*
          LX2    42
          BX6    X2
          SA6    A2          UPDATE *DTEL*
          EQ     MTRX        EXIT
 
 
 ADTA     CON    0           DAY LIMIT
 
 
**        TABLE OF DAY LIMITS.
 
 
 TDLM     EQU    *-1
 
          LOC    1
 
          CON    31          JANUARY
          CON    28          FEBRUARY
*         CON    29          (LEAP YEAR)
          CON    31          MARCH
          CON    30          APRIL
          CON    31          MAY
          CON    30          JUNE
          CON    31          JULY
          CON    31          AUGUST
          CON    30          SEPTEMBER
          CON    31          OCTOBER
          CON    30          NOVEMBER
          CON    31          DECEMBER
          CON    31          JANUARY (FOR END OF YEAR)
 
          LOC    *O
 SKCF     SPACE  4,10
**        SKCF - SET K DISPLAY COMPLETE BIT.
*
*         ENTRY
*T, X0    17/,1/S,6/,12/  CPA,12/,12/  SKCF
*
*         S      SCREEN FLAG.
*                0 = LEFT SCREEN.
*                1 = RIGHT SCREEN.
*         CPA    CONTROL POINT ADDRESS.
 
 
          PMN    SKCF
 
          SA1    B7+TFSW     GET EJT ORDINAL
          SA3    SMRL
          MX7    -12
          AX2    7           SET CP NUMBER
          LX1    12
          BX3    -X7*X3      MOVING CP NUMBER
          BX1    -X7*X1      EJT ORDINAL
          BX3    X3-X2
          ZR     X1,MTRX     IF NO JOB AT CP
          ZR     X3,MTRX     IF CP MOVING
          CX3    X1,EJT      CONVERT EJT ORDINAL TO OFFSET
          LX0    59-42
          SA2    B7+DBAW     GET K DISPLAY CONTROL
          TA1    X3+JSNE,EJT GET JOB ADVANCE STATUS
          SA3    B7+FLSW     GET RA AND FL
          MX6    -18
          LX4    X2,B1
          LX1    59-6
          BX7    -X7*X3
          AX3    RSHF
          LX7    6           FL
          NG     X4,MTRX     IF RETURN STATUS NOT SELECTED
          NG     X1,MTRX     IF JOB ADVANCE SET
          MX4    -RMSK
          PL     X0,SKC1     IF PROCESSING LEFT SCREEN
          LX2    -18
 SKC1     BX3    -X4*X3
          BX2    -X6*X2      STATUS WORD RELATIVE ADDRESS
          LX3    6           RA
          IX7    X2-X7
          ZR     X2,MTRX     IF SCREEN NOT ACTIVE
          PL     X7,MTRX     IF ADDRESS BEYOND FL
          IX2    X3+X2       STATUS WORD ABSOLUTE ADDRESS
          SA3    B7+CWQW
          ERX1   X2          READ STATUS WORD
          SX6    1
          LX3    59-46
          BX6    X1+X6       SET COMPLETE BIT
          TIC    DCPC        INVALIDATE CACHE ON OTHER CPU, IF PRESENT
          EWX6   X2          WRITE STATUS WORD
          NG     X3,MTRX     IF NOT TO RECALL CPU
          SB6    B7          SET EXCHANGE PACKAGE ADDRESS
          SB3    MTRX        SET *RCC* EXIT ADDRESS
          EQ     RCC         RECALL CPU
 CPA      SPACE  4,15
**        CPA - CHECK CPU ACTIVITY.
*
*         ENTRY  (B4) = EXIT ADDRESS.
*                (B7) = CONTROL POINT ADDRESS.
*
*         EXIT   (X2) = ORIGINAL (X0).
*                (B3) = ADDRESS OF CP USING CURRENT CPU.
*                (B6) = ADDRESS OF EXCHANGE PACKAGE.
*
*         USES   X - 1, 2.
*                A - 1.
*                B - 3, 5, 6.
 
 
 CPA      BSS    0           ENTRY
          SA1    CPAL+A0     GET CPU ASSIGNMENT DATA
          SB6    B2
          AX1    24          SET CP ADDRESS
          SB3    X1
          BX2    X0          SAVE (X0)
          ZR     B7,RB4      IF CMR STORAGE REQUEST
          SB5    A0-CPAL-1
          EQ     B3,B7,RB4   IF JOB EXECUTING IN THIS CPU
          SB6    B7
          SA1    B0-B5
          AX1    24          SET CP ADDRESS
          SB5    X1
          NE     B5,B7,RB4   IF JOB NOT RUNNING IN OTHER CPU
          EQ     MTRX        EXIT
 SCA      SPACE  4,10
**        SCA - SET CP/PCP ADDRESS FROM *SMRL*.
*
*         ENTRY  (B3) = EXIT ADDRESS.
*
*         EXIT   (A2) = *SMRL*.
*
*         USES   X - 1, 2.
*                A - 2.
 
 
 SCA      BSS    0           ENTRY
          SA2    SMRL        GET STORAGE MOVE REQUEST
          MX1    -12
          BX2    -X1*X2      EXTRACT CP/PCP NUMBER
*         EQ     SCP
 SCP      SPACE  4,15
**        SCP - SET CP/PCP ADDRESS.
*
*         ENTRY  (X2) = CP/PCP NUMBER.
*                (B3) = EXIT ADDRESS.
*
*         EXIT   (X2) = CP/PCP ADDRESS.
*                (X6) = MCT INDEX FOR CP/PCP.
*                (B7) = CP/PCP ADDRESS.
*                (A6) = *UMTA*.
*                (UMTA) = MCT INDEX FOR CP/PCP.
*
*         USES   X - 1, 2, 6.
*                A - 6.
*                B - 7.
 
 
 SCP      BSS    0           ENTRY
          LX6    B1,X2       SAVE MCT INDEX
          NO
          SA6    UMTA
          TB7    X2,-SC      SUBTRACT SYSTEM CP NUMBER
          TX1    PCPA
          GE     B7,B1,SCP1  IF PSEUDO CONTROL POINT
          SB7    X2+B1
          BX1    X1-X1       REAL CP BASE ADDRESS
 SCP1     SX2    B7-B1
          LX2    7
          IX2    X1+X2       FORM ABSOLUTE ADDRESS
          SB7    X2
          JP     B3          EXIT
 UMT      SPACE  4,15
**        UMT - UPDATE MEMORY CONTROL TABLE.
*
*         ENTRY  (X0) = INCREMENT.
*                (B4) = EXIT ADDRESS.
*                (B5) = 0 IF CHANGING CM.
*                     = 1 IF CHANGING XM.
*                (UMTA) = MCT INDEX FOR CP/PCP.
*
*         EXIT   (SMRL) = 0.
*
*         USES   X - 0, 2, 3, 6, 7.
*                A - 2, 3, 6, 7.
*                B - 5.
 
 
 UMT      BSS    0           ENTRY
          SA3    SMRL        GET MOVE PARAMETERS
          SX6    X3
          BX0    X3          MOVE INCREMENT
          AX6    12
          AX0    48
          SB5    X6+         SET MEMORY TYPE
 
*         ALTERNATE ENTRY POINT WITH PARAMETERS SET.
 
 UMT1     SA2    UMTA        GET MCT INDEX
          TB5    B5,MCT
          SA3    X2+B5
          IX7    X3-X0       ADJUST UNASSIGNED FL ABOVE CP/PCP
          AX3    48-1
          SA2    X3+B5       ADJUST UNASSIGNED FL BELOW CP/PCP
          SA7    A3
          IX6    X2+X0       UPDATE MCT ENTRY FOR CP/PCP MOVED
          BX7    X7-X7
          SA6    A2          UPDATE BACKWARD LINK
          SA7    SMRL
          JP     B4          EXIT
 
 
 UMTA     CON    0           MCT INDEX FOR CP/PCP
          TITLE  PPU REQUEST PROCESSOR.
 PPR      SPACE  4
**        PPU REQUEST PROCESSOR REGISTER USAGE.
*
*
*         (A5) = OUTPUT REGISTER ADDRESS.
 PPR      SPACE  4
**        PPR - PPU REQUEST PROCESSOR.
*
*         ENTRY  (OR) = REQUEST.
 
 
 PPR      SA5    A5          READ OUTPUT REGISTER
          RC     X3          GET MONITOR MODE START TIME IF 180 MACHINE
          SX6    B0
          UX1,B4 X5          UNPACK FUNCTION CODE AND PARAMETERS
 
*         ENTRY FROM *MSCF* PROCESSOR.
 
 PPR0     SA6    PPXL        CLEAR *PP EXCHANGE PENDING*
          SB4    B4+1777B
 
*         ENTRY FROM *PMN* AND */BUFIO/MNR*.
 
 PPR0.1   PX6    B4,X3
          SX7    B4-MXFM
          SA6    CL+CMST+A0  SET FUNCTION AND BASE TIME
          SA3    X7+TPPR+MXFM-CPUM  READ PROCESSOR CONTROL WORD
          PL     X7,HNG      IF ILLEGAL REQUEST
          SB6    X3+
          TNG    X3,(/PROBE/PPR,PROBE,/MONITOR/RB6)  IF FAST EXIT
          TX2    A5-1,-FP
          BX7    X7-X7
          LX2    PPXES-PPCES
          TA2    X2+ACPP,FPX
          LX6    X3,B1       CHECK CPU SELECTION
          SB7    X2          SET CP ADDRESS
          TNG    X6,(/DCP/CPS,DCP,/MONITOR/HNG)  IF CPU SELECTION
          TJP    (/PROBE/PPR,PROBE,B6)  EXIT TO FUNCTION PROCESSOR
 
**        EXIT TO PROCESSOR WITH -
*
*         IF FAST EXIT (*FEX*) SELECTED - X2, X7, AND B7 ARE NOT SET.
*
*         (X1) = BITS 0 - 47 OF OUTPUT REGISTER.
*         (X2) = *ACPP*.
*         (X3) = PROCESSOR CONTROL WORD.
*         (X5) = OUTPUT REGISTER.
*         (X7) = 0.
*         (A2) = *ACPP* ADDRESS.
*         (B6) = PROCESSOR ADDRESS.
*         (B7) = CONTROL POINT ADDRESS.
 PPRX     SPACE  4
*         EXIT TO STORE OUTPUT REGISTER.
 
 
 PPR1     EQU    MTRC
 
 
 PPRX     EQU    MTRX
 ABTM     SPACE  4
***       ABTM - ABORT CONTROL POINT.
*
*         ENTRY
*T, OR    12/  ABTM,12/,12/,12/,12/
*
*         EXIT
*T, IR    60/  0
*T, OR    60/  0
*
*         * PP HUNG.* WILL OCCUR IF ATTEMPT IS MADE TO ABORT THE SYSTEM
*           CONTROL POINT OR AN UNOCCUPIED USER CONTROL POINT.
 
 
          PPR    ABTM,,,DCP
 
          SX5    PPET        ERROR FLAG = *PPU ABORT.*
          SB6    B0          SET ABORT FLAG
          LX5    36
          SB5    B1          FLAG *CEFM* CALL
          EQ     CEF1        CHANGE ERROR FLAG
 ACTM     SPACE  4,35
***       ACTM - ACCOUNTING FUNCTIONS.
*
*         ENTRY
*T, OR    12/  ACTM,12/  FN,36/  -
*
*         FN = 0 (ABCS) - CLEAR SRU ACCUMULATORS.
*         FN = 1 (ABBF) - ACCOUNT BLOCK BEGIN.
*         FN = 2 (ABSF) - COMPUTE SRU MULTIPLIERS CPM AND IOM.
*         FN = 3 (ABCF) - ACCOUNT BLOCK CHANGE/END.
*         FN = 4 (ABEF) - COMPUTE/CONVERT ELAPSED SRUS.
*         FN = 5 (ABVF) - CONVERT ACCUMULATORS.
*         FN = 6 (ABIF) - INCREMENT ACCUMULATOR.
*         FN = 7 (ABUS) - GET RAW CP TIME - USAGE PRICING.
*         FN = 10 (ABOF) - CONVERT OTHER ACCUMULATORS.
*
*
*      0  ABCS - CLEAR SRU ACCUMULATORS.
*
*         ENTRY
*T, OR    12/  ACTM,12/  ABCS,36/
*
*         EXIT
*T, OR    60/  0
*
*         FUNCTION
*         CLEARS SRU ACCUMULATORS IN CPA WORDS *SRJW* AND *SRUW*.
*
*
*      1  ABBF - ACCOUNT BLOCK BEGIN.
*
*         ENTRY
*T, OR    12/  ACTM,12/  ABBF,36/  -
*T, MB    12/  M1,12/  M2,12/  M3,12/  M4,12/  ADDER
*
*         EXIT
*T, OR    60/  0
*
*         FUNCTION
*         BEGIN ACCOUNT BLOCK BY INSERTING NEW MULTIPLIERS IN CONTROL
*         POINT AREA AND APPLYING THE INITIAL ADDER TO THE SRU
*         ACCUMULATOR.  THE MULTIPLIERS CPM AND IOM ARE CALCULATED.
*
*
*      2  ABSF - COMPUTE SRU MULTIPLIERS CPM AND IOM.
*
*         ENTRY
*T, OR    12/  ACTM,12/  ABSF,36/  -
*
*         EXIT
*T, OR    60/  0
*
*         FUNCTION
*         THE MULTIPLIERS CPM AND IOM ARE CALCULATED USING THE
*         CURRENT CM AND ECS FIELD LENGTHS.
*
*
*      3  ABCF - ACCOUNT BLOCK CHANGE/END.
*
*         ENTRY
*T, OR    12/  ACTM,12/  ABCF,36/  -
*T, MB    12/  M1,12/  M2,12/  M3,12/  M4,12/  ADDER
*
*         EXIT
*T, OR    60/  0
*
*         FUNCTION
*         CHANGE/END ACCOUNT BLOCK BY CLEARING SRU ACCUMULATORS,
*         REPLACING MULTIPLIERS IN CONTROL POINT AREA AND APPLYING THE
*         ADDER TO THE SRU ACCUMULATOR.  THE MULTIPLIERS CPM AND IOM
*         ARE CALCULATED.
*
*
*      4  ABEF - COMPUTE/CONVERT ELAPSED SRUS.
*
*         ENTRY
*T, OR    12/  ACTM,12/  ABEF,36/  -
*T, MB+0  60/  OLD SRU ACCUMULATOR
*T, MB+1  60/  NEW SRU ACCUMULATOR
*
*         EXIT
*T, OR    60/  0
*T, MB    60/  ELAPSED SRUS IN F10.3 FORMAT
*
*         FUNCTION
*         ELAPSED SRUS (NEW-OLD) ARE CONVERTED AND PROGRAM MODE IS
*         ENTERED FOR THE CONVERSION BY *RDC*.  IF ELAPSED SRUS
*         ARE LESS THAN OR EQUAL TO *MDSR*, ZERO IS RETURNED.
*
*
*      5  ABVF - CONVERT ACCUMULATORS.
*
*         ENTRY
*T, OR    12/  ACTM,12/  ABVF,36/  -
*T, MB+0  60/  SRUW CONTROL POINT AREA WORD
*T, MB+1  60/  CPTW CONTROL POINT AREA WORD
*T, MB+2  60/  IOAW CONTROL POINT AREA WORD
*T, MB+3  60/  MP1W CONTROL POINT AREA WORD
*
*         EXIT
*T, OR    60/  0
*T, MB+0  60/  SRU ACCUMULATOR IN F10.3 FORMAT
*T, MB+1  60/  CP ACCUMULATOR IN F10.3 FORMAT
*T, MB+2  60/  MS ACCUMULATOR IN F10.3 FORMAT
*T, MB+3  60/  MT ACCUMULATOR IN F10.3 FORMAT
*T, MB+4  60/  PF ACCUMULATOR IN F10.3 FORMAT
*T, MB+5  60/  AD ACCUMULATOR IN F10.3 FORMAT
*
*         FUNCTION
*         THE ACCUMULATORS ARE UNPACKED AND STORED 1 PER WORD IN (MB)
*         AND PROGRAM MODE IS ENTERED FOR CONVERSION BY *RDC*.  IF
*         TOTAL SRUS ARE LESS THAN OR EQUAL TO *MCSR*, *MCSR* IS
*         RETURNED AS THE SRU ACCUMULATOR.
*
*
*       6 ABIF - INCREMENT ACCUMULATOR.
*
*         ENTRY
*T, OR    12/  ACTM,12/  ABIF,30/ ,3/OP,3/CT
*T, MB+0  30/ ,30/INCREMENT TO APPLY
*T, MB+1  60/ ACCUMULATOR VALUE
*
*         OP = OPERATION FLAG (0 = ADD, 1 = SUBTRACT)
*         CT = REQUEST COUNT (1-3)
*
*         EXIT
*T, OR    60/  0
*T, MB+0  30/ NO CHANGE,30/ NEW VALUE FIRST OPERATION
*T, MB+2  30/ NO CHANGE, 30/ NEW VALUE SECOND OPERATION
*
*         FUNCTION
*         THE SRU ACCUMULATOR VALUE IS FIRST CONVERTED TO AN INTEGER
*         NUMBER AND THEN INTEGER ADDITION OR SUBTRACTION IS
*         PERFORMED.  IF THE CONVERTED ACCUMULATOR VALUE IS LESS THAN
*         1, 1 IS USED. THE UPPER HALF OF THE WORDS CONTAINING
*         THE INCREMENTS WILL BE PRESERVED IN THE UPPER HALF OF THE
*         REPLY.
*
*
*       7 ABUS - GET RAW CP TIME - USAGE PRICING.
*
*         ENTRY
*T, OR    12/  ACTM,12/  ABUS,36/  -
*T, MB+0  60/  CPTW CONTROL POINT AREA WORD
*T, MB+1  60/  CPJW CONTROL POINT AREA WORD
*
*         EXIT
*T, OR    60/  0
*T, MB    60/  ELAPSED APPLICATION UNITS IN F10.3 FORMAT
*
*         FUNCTION
*         ELAPSED CP SECONDS (CPTW-CPJW) IS CALCULATED AND THE
*         CPU 0 MULTIPLIER IS FACTORED, TO OBTAIN RAW CP SECONDS.
*         PROGRAM MODE IS ENTERED FOR CONVERSION BY *RDC*.
*
*      10 ABOF - CONVERT OTHER ACCUMULATORS.
*
*         ENTRY
*T,OR     12/  ACTM,12/  ABOF,36/ -
*T,MB+0   60/  MPAW/ODAW CONTROL POINT AREA WORD
*T,MB+1   60/  AUCW CONTROL POINT AREA WORD
*
*         EXIT
*T,OR     60/  0
*T,MB+0   60/  MP ACCUMULATOR IN F10.3 FORMAT
*T,MB+1   60/  AUC ACCUMULATOR IN F10.3 FORMAT
*T,MB+2   60/  OD ACCUMULATOR IN F10.3 FORMAT
*
*         FUNCTION
*         THE ACCUMULATORS ARE UNPACKED AND STORED 1 PER WORD
*         IN (MB) AND PROGRAM MODE IS ENTERED FOR CONVERSION
*         BY ROUTINE *RDC*.
 
 
          PPR    ACTM,,RDC
 
          AX1    36          GET FUNCTION NUMBER
          SB4    X1-TACTL
          SA1    A5+B1       GET (MB)
          PL     B4,HNG      IF ILLEGAL FUNCTION
          JP     TACT+TACTL+B4  JUMP TO PROCESS FUNCTION
 
*         OPTION TABLE.
 
 TACT     BSS    0
          LOC    0
 
+         SB4    B0          (ABCS) - CLEAR SRU ACCUMULATORS
          MX6    0
          EQ     ACT1        CLEAR *SRJW* AND *SRUW* FIELDS
 
 +        EQ     ACT2        (ABBF) - ACCOUNT BLOCK BEGIN
 
 +        EQ     ACT4        (ABSF) - COMPUTE SRU MULTIPLIERS CPM AND IO
 
 +        MX6    0           (ABCF) - ACCOUNT BLOCK CHANGE/END
          EQ     ACT1
 
 +        SA2    A1+B1       (ABEF) - COMPUTE/CONVERT ELAPSED SRUS
          MX3    -42
          EQ     ACT6
 
 +        SA1    A1+3        (ABVF) - CONVERT ACCUMULATORS
          EQ     ACT7
 
+         SB6    3           (ABIF) - INCREMENT ACCUMULATORS
          EQ     ACT10
 
+         BX6    X1          (ABUS) - GET RAW CP TIME - USAGE PRICING
          MX0    -30
          EQ     ACT15
 
          SA1    A1+B1       (ABOF) - CONVERT OTHER ACCUMULATORS
          MX2    -29
          EQ     ACT9.1
 
 
 TACTL    BSS    0
          LOC    *O
 
*         CLEAR SRU ACCUMULATORS.
*         (X6) = 0.
 
 ACT1     SA2    B7+SRJW     CLEAR SRU ACCUMULATOR SET AT START OF JOB
          SA6    B7+SRUW     CLEAR RUNNING ACCUMULATOR
          MX3    30
          BX7    X3*X2
          SA7    A2+
          SX7    B0+
          PL     B4,PPR1     IF *ABCS* SUBFUNCTION
 
*         STORE MULTIPLIERS IN CONTROL POINT AREA.
*         (X1) = 12/ M1,12/ M2,12/ M3,12/ M4,12/ ADDER
 
 ACT2     SX6    MPSR        SET MAP MULTIPLIER
          SA3    B7+MPMW
          MX2    -12
          LX1    12
          MX4    -42
          BX5    -X2*X1      (X5) = M1
          IX6    X6*X5       M1 * MAP MULTIPLIER
          BX4    -X4*X3
          SA3    B7+MP2W
          LX6    42
          BX6    X4+X6
          SA6    B7+MPMW
          SB4    B1+B1       SET LOOP COUNT
          SX4    1000
 ACT3     LX1    12
          IX6    X5*X4       PASS 1 - M1*1000     PASS 2 - M1*M3
          BX4    -X2*X1
          IX7    X5*X4       PASS 1 - M1*M2       PASS 2 - M1*M4
          LX6    42
          MX4    -24
          LX7    24          POSITION MULTIPLIERS
          BX3    -X4*X3
          IX6    X6+X7       COMBINE MULTIPLIERS
          LX1    12
          IX6    X6+X3       INSERT MULTIPLIERS
          BX4    -X2*X1
          SA6    A3+
          SB4    B4-B1       DECREMENT LOOP COUNT
          SA3    A3-B1       PASS 2 - STORE M1*M3 AND M1*M4 IN MP1W
          NZ     B4,ACT3     IF PASS 2
 
*         APPLY ADDER TO SRU ACCUMULATOR.
*         (X1) = 48/ -,12/ ADDER
 
          SB3    ACT4        SET RETURN ADDRESS
          BX1    X4
          NZ     X4,AAD      IF ADDER TO APPLY
 
*         CALCULATE SRU MULTIPLIERS CPM AND IOM.
 
 ACT4     SB4    ACT5        SET RETURN ADDRESS
          EQ     SRU         CALCULATE CPM AND IOM
 
 ACT5     MX7    0           SET TO CLEAR (OR)
          EQ     PPR1        EXIT
 
*         COMPUTE AND CONVERT ELAPSED SRUS.
*         (X1) = OLD SRU ACCUMULATOR.  (X2) = NEW SRU ACCUMULATOR.
 
 ACT6     LX1    12          RESTORE ORIGINAL ACCUMULATOR SIZE
          SA4    ACTA        SET MINIMUM DISPLAY VALUE
          BX1    -X3*X1      ISOLATE OLD SRUS
          SX7    10001B      PARAMETERS FOR RDC (PROGRAM MODE)
          BX2    -X3*X2      ISOLATE NEW SRUS
          IX6    X2-X1       NEW - OLD
          SA6    A1          STORE ELAPSED SRUS IN (MB)
          IX4    X6-X4       COMPARE TO MINIMUM
          PL     X4,ACT9     IF GREATER THAN MINIMUM
          MX7    0           SET TO CLEAR (OR)
          SA7    A5+B1       CLEAR (MB)
          EQ     PPR1        EXIT
 
*         CONVERT ACCUMULATORS.
*         (X1) = (MB+3) - MP1W WORD FROM CONTROL POINT AREA.
 
 ACT7     MX2    -20         SET ACCUMULATOR MASK
          SB6    3           SET ACCUMULATOR COUNT
          BX6    -X2*X1      ISOLATE AD ACCUMULATOR
          SX7    60201B      PARAMETERS FOR *RDC* (PROGRAM MODE)
          SA1    A1-1        GET MS, MT AND PF ACCUMULATORS
 ACT8     SA6    A1+B6       STORE ACCUMULATOR
          BX6    -X2*X1      ISOLATE NEXT ACCUMULATOR
          AX1    20          SHIFT FOR NEXT PASS
          SB6    B6-B1       DECREMENT ACCUMULATOR COUNT
          PL     B6,ACT8     IF MORE TO MOVE
          SA1    ACTB        SET MINIMUM CHARGE VALUE
          SA2    A5+B1       SRU ACCUMULATOR
          MX6    -42
          BX6    -X6*X2      ISOLATE SRU ACCUMULATOR
          IX6    X6-X1
          PL     X6,ACT9     IF GREATER THAN MINIMUM
          BX6    X1
          SA6    A2
 
*         ENTER PROGRAM MODE FOR CONVERSION BY RDC.
*         (X5) = (OR).  (X7) = RDC PARAMETERS.
 
 ACT9     MX1    12          SET (OR) MASK
          LX7    24          POSITION RDC PARAMETERS
          BX5    X1*X5       ISOLATE (OR) FUNCTION CODE
          IX5    X5+X7       INSERT RDC PARAMETERS
          EQ     PMR         ENTER PROGRAM MODE
 
*         CONVERT OTHER ACCUMULATORS.
*         (X1) = (MB+1) - AUCW WORD FROM CONTROL POINT AREA
 
 ACT9.1   BX6    -X2*X1      ISOLATE AUC ACCUMULATOR
          SA1    A1-B1       GET MP/OD ACCUMULATOR
          SA6    A1+B1
          MX2    -20         SET ACCUMULATOR MASK
          BX7    -X2*X1
          SA7    A1+         STORE MP ACCUMULATOR
          LX1    -20
          BX6    -X2*X1
          SA6    A6+B1       STORE OD ACCUMULATOR
          SX7    30000B      PARAMETERS FOR *RDC* (PROGRAM MODE)
          EQ     ACT9        PROCESS CONVERSION IN *RDC*
 
*         INCREMENT ACCUMULATOR.
 
 ACT10    MX0    -3
          BX2    -X0*X5      REQUEST COUNT
          SB5    X2
          AX5    3
          BX2    -X0*X5      OPERATION FLAG
          SB4    X2+
          MX0    -42
          ZR     B5,HNG      IF NO REQUEST COUNT
          GT     B5,B6,HNG   IF ILLEGAL REQUEST COUNT
          GT     B4,B1,HNG   IF ILLEGAL OPERATION FLAG
 ACT11    MX3    -30
          SA2    A1+B1       GET NEXT PARAMETER
          BX2    -X0*X2
          BX5    -X3*X1
          PX2    X2          CONVERT ACCUMULATOR TO UNITS
          BX1    X3*X1       PRESERVE UPPER HALF
          SA3    HTH
          FX4    X3*X2       .0000001
          UX2    X4
          NZ     X2,ACT12    IF ACCUMULATOR NOT LESS THAN 1
          SX2    B1
 ACT12    ZR     B4,ACT14    IF ADDITION DESIRED
          IX6    X2-X5
 ACT13    SA6    A1          STORE REPLY IN MESSAGE BUFFER
          EQ     B5,B1,PPR1  IF ALL REQUESTS HONORED
          SA1    A2+B1
          SB5    B5-B1
          EQ     ACT11       PROCESS NEXT REQUEST
 
 ACT14    IX6    X2+X5       PERFORM ADDITION
          BX6    X1+X6
          JP     ACT13
 
*         GET RAW CP TIME - USAGE PRICING.
 
 ACT15    SB4    ACT15.1     SET *MSB* RETURN ADDRESS
          SA2    CPTB        CONVERT QUARTER NANOUNITS TO MILLIUNITS
          EQ     /PROGRAM/MSB  MULTIPLY 60 BIT INTEGER
 
 ACT15.1  SA2    A1+B1       GET *CPJW* VALUE
          AX6    8
          BX2    -X0*X2
          IX6    X6-X2       CALCULATE NUMBER OF CP QUARTER SECONDS
          NZ     X6,ACT16    IF NOT LESS THAN MINIMUM
          SX6    B1+
 ACT16    SX7    10100B      PARAMETERS FOR *RDC* (PROGRAM MODE)
          SA2    =250000     CONVERT TO CP MICROSECONDS
          IX6    X6*X2
          SA2    ACTC
          ZR     X2,ACT17    IF NO MULTIPLIER CALCULATION REQUIRED
          PX6    X6          FACTOR OUT THE CPU MULTIPLIER
          NX6    X6
          RX6    X6*X2
          UX6,B6  X6
          LX6    X6,B6
 ACT17    SX2    4000        CONVERT TO CP QUARTER NANOSECONDS
          IX6    X6*X2
          SA6    A1
          EQ     ACT9        TO CONVERT RAW CP MILLISECOND VALUE
 
 ACTA     CON    MDSR*10000  MINIMUM DISPLAY VALUE FOR SRU ACCUMULATOR
 ACTB     CON    MCSR*10000  MINIMUM CHARGE VALUE FOR SRU ACCUMULATOR
 ACTC     CON    0.0         MULTIPLIER FOR APPLICATION  ACCOUNTING
 AFAM     SPACE  4,10
***       AFAM - ACCESS FAST ATTACH.
*         AFAM ATTACHES OR RELEASES FAST ATTACH FILES.
*
*         ENTRY
*T OR     12/  AFAM,12/  EQ,1/  NR,11/  P1,12/  SF,12/  P2
*         EQ     EST ORDINAL OF DEVICE WHERE THE FAST
*                ATTACH FILE RESIDES, IF GLOBAL FAST ATTACH FILE.
*                0, IF LOCAL FAST ATTACH FILE.
*         NR     NON-ROLLABLE OPTION (VALID ONLY ON WRITEABLE MODES
*                FOR *AFAS* SUBFUNCTION).
*         P1     MODE OF ATTACH.
*         P2     FNT ORDINAL.
*         SF     SUBFUNCTION CODE AS DEFINED IN COMSCPS.
*                AFAS = 0 = ATTACH FAST ATTACH FILE.
*                RFAS = 1 = RETURN FAST ATTACH FILE.
*
*         EXIT
*T, OR    12/  0,12/  ST,24/  ,4/  WF,6/  ,1/  NR,1/
*         ST = 0 IF FUNCTION COMPLETE.
*         ST = 1 IF FUNCTION CANNOT BE COMPLETED AT THIS TIME.
*                FILE IS ATTACHED IN A CONFLICTING MODE.
*         WF .NE. 0 IF FILE ALREADY ATTACHED IN A WRITABLE MODE (AFAS
*                   REJECT ONLY).
*         NR = NON-ROLLABLE FLAG (AFAS REJECT ONLY).
*
*         *PP HUNG*  WILL OCCUR IF -
*         1)  ILLEGAL FUNCTION CODE IS DETECTED.
*         2)  ILLEGAL FNT ORDINAL DETECTED.
*         3)  ILLEGAL MODE NUMBER DETECTED.
*         4)  FILE NOT *FAFT*.
*
*                THIS FUNCTION MAY BE REJECTED IF -
*         1)  THE GLOBAL FST IS BUSY.
*         WHEN THIS OCCURS BIT 59 OF OR IS SET AND *PPR* WILL
*         RECALL CPUMTR TO RETRY THE REQUEST.
*
*         NOTE - AFTER AN *AFAS* SUBFUNCTION, IT IS THE RESPONSIBILITY
*         OF THE CALLER TO ENSURE THAT THE TRT ON THIS MAINFRAME
*         IS CURRENT.  IN SOME CASES, THIS MAY REQUIRE AN EXPLICIT
*         *STBM/UTRS* REQUEST FOR AN UP-TO-DATE TRT.  NOTE THAT WHEN
*         A FILE IS TO BE ACCESSED VIA *CIO* CALLS, CERTAIN ACCESS
*         MODES (M, RM, A, RA) WILL FORCE *STBM* CALLS BEFORE
*         EACH ACCESS.  THEREFORE, WHEN *PFM* ATTACHES A FILE IN
*         SUCH A MODE, A TRT UPDATE REQUEST IS NOT NEEDED.
*
*         NOTE - IF A FAST ATTACH FILE RESIDES ON AN INDEPENDENT
*         SHARED DEVICE, *1FA* PROCESSES THE REQUEST DIRECTLY
*         WITHOUT CALLING *AFAM*.  *1FA* MAINTAINS THE COUNTS AND
*         INTERLOCKS IN THE SYSTEM SECTOR INSTEAD OF THE FST.
 
 
          PPR    AFAM,(/ISD/CHR,ISD,/MMF/AFAP,MMF,/MONITOR/.AFAM)
          LX1    48
          MX4    -12
          BX6    -X4*X1
          LX6    59
          SB6    X6+
          SB5    PPRX        SET *REJ* EXIT
          NZ     B6,HNG      IF ILLEGAL SUBFUNCTION
          LX1    48          POSITION ATTACH MODE
          BX5    -X4*X5      EXTRACT FNT ORDINAL
          TX7    X5,-FNTM    ORDINAL - MAXIMUM NUMBER OF ENTRIES
          MX0    -11
          BX3    -X0*X1      MODE OF FAST ATTACH FILE
          SX0    X3-TFASL
          BX7    X7*X0
          PL     X7,HNG      IF ILLEGAL FNT ORDINAL/ATTACH MODE
          CX2    X5,FNT
          TA2    X2+FNTG,FNT GET FNT ENTRY
          BX0    -X4*X2
          AX0    6
          SA3    TFAS+X3     READ MODE PARAMETERS
          SX0    X0-FAFT
          LX2    -1
          NG     X2,REJ      IF FILE BUSY
          LX2    -11
          MX5    -6
          BX2    -X5*X2
          NZ     X0,HNG      IF NOT *FAFT* FILE
          SA1    A2+B1       GET FST ENTRY
          ERRNZ  FSTG-FNTG-1 CODE DEPENDS ON VALUE
          SB4    A1          FST ADDRESS
          TNZ    X2,(/MMF/SFI,MMF,/LSPMMF/AFA)  IF FAT ENTRY IN EM
 
*         PERFORM UPDATE.
 
 AFA1     UX3,B6 X3          (B6) = POSITION OF FIELD
          BX2    -X4*X3      (X2) = FIELD MASK
          AX5    X1,B6       POSITION FIELD TO BOTTOM OF WORD
          LX3    -24
          BX5    X2*X5       CURRENT VALUE OF FIELD
          BX4    -X4*X3
          MX7    1
          LX4    X4,B6       INCREMENT SHIFTED TO FIELD POSITION
          NG     X6,AFA2     IF DECREMENTING FIELD
          UX3,B5 X3          (B5) = -MASK WIDTH
          LX3    -12
          AX6    X7,B5       FORM BUSY MASK
          BX4    -X4         COMPLEMENT INCREMENT VALUE
          SB5    X3          SET POSITION OF BUSY MASK
          LX6    X6,B5
          BX5    X2-X5
          BX3    -X6*X1      CHECK IF BUSY STATUS
          NZ     X3,AFA5     IF FILE BUSY
 AFA2     ZR     X5,AFA5     IF OVERFLOW/UNDERFLOW
          SB5    B6-8
          IX6    X1-X4       INCREMENT/DECREMENT FIELD
          SX2    B1+B1
          NZ     B5,AFA4     IF NOT WRITABLE MODE
          SA5    A5
          LX5    59-12
          NG     X5,AFA3     IF RETURNING FAST ATTACH FILE
          LX5    59-35-59+12
          PL     X5,AFA4     IF NON-ROLLABLE BIT NOT REQUESTED
          BX6    X2+X6       SET NON-ROLLABLE BIT
          EQ     AFA4        STORE GLOBAL WORD
 
 AFA3     BX6    -X2*X6      CLEAR NON-ROLLABLE BIT
 AFA4     SA6    A1          STORE GLOBAL WORD
          TNZ    X0,(/MMF/CFI,MMF,/MONITOR/HNG)  IF FAT ENTRY IN EM
          SX7    B0
          EQ     CSM         CHECK FOR STORAGE MOVE
 
 AFA5     LX7    37          POSITION STATUS
          TNZ    X0,(/MMF/CFI1,MMF,/MONITOR/HNG)  IF EM PROCESSING
 AFA6     ZR     X7,CSM      IF NO REJECT
          MX4    -12
          BX3    -X4*X1
          BX7    X7+X3
          EQ     CSM         CHECK FOR STORAGE MOVE
          SPACE  4,15
**        AFAM PARAMETER TABLE FORMAT.
*         THE FOLLOWING TABLE DEFINES THE PARAMETERS NEEDED TO PERFORM
*         1) BUSY CHECK.
*         THE BUSY CHECK IS PERFORMED BY DEFINING A FIELD IN THE WORD
*         WHICH MUST BE ZERO FOR THE UPDATE TO TAKE PLACE.
*         2) OVERFLOW/UNDERFLOW CHECK.
*         3) INCREMENT/DECREMENT OF FIELDS UPDATED BY *AFAM* FUNCTIONS.
*
*T, AFAM  12/  P1,12/  P2,12/  INC,12/  W,12/  MAX
*         P1     POSITION OF FIELD TO INCREMENT + 2000B
*         P2     POSITION OF BUSY MASK
*         INC    VALUE TO USE FOR INCREMENT/DECREMENT
*         W      2073B - WIDTH OF BUSY MASK
*         MAX    MAXIMUM VALUE OF FIELD (FOR INCREMENT)
*         MAX    FIELD MASK (FOR DECREMENT)
 
 
 TFAS     BSS    0           TABLE OF FAST ATTACH PROCESSING PARAMETERS
          LOC    0
 
          VFD    12/2000B+8,12/2,12/7,12/2073B-34,12/7      WRITE
          VFD    12/2000B+12,12/8,12/1,12/2073B-4,12/77B    READ
          VFD    12/2000B+8,12/2,12/1,12/2073B-16,12/1      APPEND
          VFD    12/2000B+12,12/8,12/1,12/2073B-4,12/77B    EXECUTE
          VFD    12/2000B,12/0,12/0,12/2073B-59,12/0        NULL
          VFD    12/2000B+8,12/2,12/3,12/2073B-22,12/3      MODIFY
          VFD    12/2000B+24,12/10,12/1,12/2073B-1,12/7777B R/MODIFY
          VFD    12/2000B+18,12/9,12/1,12/2073B-3,12/77B    R/APPEND
          VFD    12/2000B+8,12/8,12/10B,12/2073B-16,12/10B  UPDATE
          VFD    12/2000B+2,12/8,12/1,12/2073B-3,12/77B     R/UPDATE
          LOC    *O
 
 TFASL    EQU    *-TFAS
 BFMM     SPACE  4,25
***       BFMM - BUFFERED I/O BUFFER MANAGER CALL.
*
*         ENTRY
*T  OR    12/  BFMM,6/  NBI,1/I,5/,6/  CP,18/  FNTA,6/  OP,6/  PA
*         NBI    NUMBER OF ADDITIONAL WRITE BUFFERS TO
*                INTERLOCK (FOR *BMVI* OPERATION ONLY).
*                MAXIMUM OF 10D ADDITIONAL BUFFERS IS ALLOWED.
*         I      CURRENT BUFFER ALREADY INTERLOCKED FLAG
*                (FOR *BMVI* OPERATION ONLY).
*         CP     CONTROL POINT NUMBER IF PSEUDO-PP CALL.
*                0 IF PP CALL.
*         FNTA   FNT RELATIVE ADDRESS IN NEGATIVE IF PSEUDO-PP CALL.
*                PSEUDO-FNT ADDRESS IF PP CALL.
*                EST ORDINAL OF EQUIPMENT TO PROCESS IF *BMFW* OR
*                  *BMDD* OPERATION.
*                0 IF *BMFW* TO PROCESS ALL EQUIPMENTS.
*         OP     OPERATION CODE.
*                BMRD = READ BUFFER.
*                BMWR = WRITE BUFFER.
*                BMRW = REWRITE BUFFER.
*                BMVI = VALIDATE AND INTERLOCK BUFFER.
*                BMRG = RELEASE READ BUFFER AND GET NEXT BUFFER.
*                BMRB = RELEASE READ BUFFER.
*                BMFL = FLUSH BUFFER.
*                BMRF = RELEASE AND FLUSH WRITE BUFFER.
*                BMFW = FLUSH ALL WRITE BUFFERS.
*                BMTR = TERMINATE SHARED DEVICE READ ACCESS.
*                BMTW = TERMINATE SHARED DEVICE WRITE ACCESS.
*                BMDB = DROP ALL BUFFERS FOR FILE.
*                BMDD = DROP ALL BUFFERS ON DEVICE.
*                BMCR = COMPLETE SHARED DEVICE READ ACCESS REQUEST.
*                BMCW = COMPLETE SHARED DEVICE WRITE ACCESS REQUEST.
*         PA     OPERATION CODE DEPENDENT PARAMETER.
*                FOR *BMRD* - BUFFER COUNT.
*                  0 = USE DEFAULT BUFFER COUNT.
*                  BUFFER COUNT IF .NE. 0.
*                FOR *BMWR* - RECALL ALLOWED FLAG.
*                  0 = RECALL ALLOWED.
*                  1 = RECALL NOT ALLOWED.
*                FOR *BMVI* - OPERATION CODE TO BE EXECUTED IF BUFFER
*                  CANNOT BE INTERLOCKED IN MONITOR MODE.
*                  *BMRD* = INTERLOCK FOR READ.
*                  *BMWR* = INTERLOCK FOR WRITE.
*                FOR *BMRF* - WRITE OPERATION CODE TO BE EXECUTED ON
*                  NEXT BUFFER AFTER FLUSH OF CURRENT BUFFER.
*                  0 = NO WRITE OPERATION.
*                  *BMWR* = WRITE BUFFER.
*                  *BMRW* = REWRITE BUFFER.
*                 FOR *BMFW* - RESTART 819 I/O FLAG.
*                   0 = DO NOT RESTART 819 I/O.
*                   RESTART 819 I/O IF .NE. 0.
*                 FOR *BMCR*, *BMCW* - STATUS CODE.
*                   0 = NORMAL COMPLETION.
*                   1 = *BRT* ENTRY EVICTED BY *MTE*.
*                   2 = OTHER MACHINE CANNOT RELEASE WRITE ACCESS.
*
*T FNT+0  60/
*T,FNT+1  3/,9/  EQ,12/,12/  CT,12/  CS,12/
*T,FNT+2  48/,12/  BI
*         EQ     EST ORDINAL.
*         CT     CURRENT LOGICAL TRACK.
*         CS     CURRENT LOGICAL SECTOR.
*         BI     BUFFER INDEX FOR OP = BMVI, BMRG, BMRB AND BMRF.
*
*         EXIT
*T, OR    36/0, 12/  BI,5/  ST,7/0
*         BI     BUFFER INDEX.
*         ST     STATUS.
*                BIT 11 SET IF BUFFER RECALL.
*                BIT 10 SET IF BUFFER BUSY.
*                BIT  9 SET IF I/O ERROR.
*                BIT  8 SET IF INACCESSIBLE DEVICE.
*                BIT  7 SET IF ADDRESS ERROR.
*
*         FOR *BMVI* OPERATION WITH *BMWR* OR *BMRW* SUBFUNCTION,
*         ORDINALS OF ADDITIONAL WRITE BUFFERS INTERLOCKED ARE RETURNED
*         IN *MB* AND *MB*+1 -
*
*T, MB    12/  BF5,12/  BF4,12/  BF3,12/  BF2,12/  BF1
*T, MB+1  12/  BF10,12/  BF9,12/  BF8,12/  BF7,12/  BF6
*         BF(N)  BUFFER INDEX OF (N)TH MULTIPLE WRITE
*                BUFFER RESERVED FOR *BMVI* OPERATION (ZERO
*                INDICATES NO (N)TH BUFFER INTERLOCKED).
*
*
*         HANG CONDITIONS -
*
*         1.  INVALID OPERATION CODE.
*         2.  INVALID SUBFUNCTION FOR *BMVI* OPERATION.
*         3.  MULTIPLE WRITE BUFFER COUNT .GT. 10D FOR *BMVI*
*             OPERATION.
*         4.  NEXT TRACK NOT RESERVED WHEN NEEDED FOR MULTIPLE
*             WRITE BUFFER REQUEST.
 
 
          PPR    BFMM,(/BUFIO/BFM,BUFIO,/MONITOR/HNG),(/BUFIO/BFM3,BUFIO
,,/PROGRAM/HNG)
 BIOM     SPACE  4,40
***       BIOM - BUFFERED I/O CONTROL.
*
*         THIS FUNCTION PROCESSES CPU INTERRUPTS BY DEDICATED BUFFERED
*         DEVICE DRIVERS.  NOTE THAT THESE DRIVERS DO NOT USE *PPR* TO
*         ISSUE THE *BIOM* MONITOR FUNCTION, THEREFORE, THE FLAGS IN
*         BITS 59-56 OF THE PP OUTPUT REGISTER ARE NOT RECOGNIZED.
*
*         ENTRY -
*T, OR    12/ BIOM, 12/ SF, 12/ PO, 1/ I, 11/ NB, 12/ P1
*
*         SF     SUBFUNCTION -
*                SUIS = 0 = SET UNIT INTERLOCK.
*                DCBS = 1 = DELINK CONTROL BUFFERS.
*                SETS = 2 = SET ERROR STATUS IN *CBT*.
*                IDSS = 3 = INHIBIT DATA STREAMING.
*                CETS = 4 = CLEAR ERROR STATUS FROM I/O QUEUE.
*
*         PO     *PUT* ORDINAL.
*         I      CLEAR UNIT INTERLOCK FLAG.
*         NB     NUMBER OF CONTROL BUFFERS TO PROCESS.
*                (THE UNIT INTERLOCK FLAG MUST BE SET IF THE *PROBE*
*                TABLE *IOST* IS TO BE UPDATED.)
*         P1     FOR *DCBS* SUBFUNCTION, NUMBER OF CBT-S PROCESSED.
*                FOR *SETS* SUBFUNCTION, ERROR CODE.
*                FOR *PCIS* SUBFUNCTION, CHANNEL NUMBER.
*                FOR OTHER SUBFUNCTIONS, UNUSED.
*
*         EXIT -
*T, OR    12/0, 12/ ST, 36/0
*
*         ST     REPLY STATUS - *SUIS*
*             =  0 IF UNIT INTERLOCK SET FOR CALLING PP.
*             =  OR ADDRESS OF PP HOLDING UNIT INTERLOCK.
*
*                REPLY STATUS - *SETS*
*             =  0 IF ERROR RECOVERY ON ALTERNATE CHANNEL.
*             =  1 IF NO ERROR RECOVERY.  CALLER IS RESPONSIBLE FOR
*                  ISSUING ALL MESSAGES ASSOCIATED WITH THE ERROR.
*
*                REPLY STATUS - *PCIS*
*             =  0 IF CHANNEL MAY BE DOWNED ON SPECIFIED UNIT.
*             =  1 IF REQUESTS REQUIRING SPECIFIED CHANNEL ARE STILL
*                  PENDING ON SPECIFIED UNIT.
*
*                REPLY STATUS - ALL OTHER SUBFUNCTIONS
*             =  0.
*
*         *PP HUNG.* WILL OCCUR IF-
*         1)     BUFFER COUNT = 0 ON AN I/O COMPLETE.
 
 
          PPR    BIOM,(/IHPFMD/BIO,IHPFMD,/MONITOR/HNG),,FEX
 BMIM     SPACE  4,10
***       BMIM - BUFFERED MEMORY INVALIDATION.
*
*         THIS FUNCTION IS USED TO INVALIDATE BUFFERED MEMORY.  IT
*         SHOULD BE USED ONLY ON CYBER 170-835 AND CYBER 170-855
*         MACHINES.  IF CACHE IS NOT PRESENT, THE FUNCTION IS IGNORED.
*
*         ENTRY
*T, OR    12/  BMIM,12/  SF,12/,12/  MF,12/
*         SF     SUBFUNCTION -
*                ICMS = 1    INVALIDATE CACHE MEMORY.
*         MF     MODE FLAG -
*                = 0  IF CENTRAL MEMORY.
*                = 1  IF EXTENDED MEMORY.
*
*         EXIT
*T, OR    60/0
*
*         PP HANG CONDITIONS -
*                INVALID SUBFUNCTION.
*                INVALID MODE FLAG ON *ICMS* SUBFUNCTION.
 
 
          PPR    BMIM
 
          SA1    MABL        GET LOWER CYBER 170-8XX FLAG
          MX4    -4
          LX1    59-47
          NG     X1,MTRC     IF NOT LOWER CYBER 170-8XX MAINFRAME
          SA1    EABL+CPEI   GET PROCESSOR 0 DESCRIPTOR POINTER
          LX1    18
          SA1    X1+/DSL/DEGR/5  GET SECOND WORD OF DESCRIPTOR
          LX1    0-47
          LX1    0-12
          BX1    -X4*X1      CACHE DEGRADATION FLAGS
          NZ     X1,PPR1     IF NO CACHE PRESENT
          MX0    -12
          BX3    X5
          LX3    0-36
          BX3    -X0*X3      SUBFUNCTION
          SB4    X3-TBMIL
          ZR     X3,HNG      IF INVALID SUBFUNCTION
          PL     B4,HNG      IF INVALID SUBFUNCTION
          JP     B4+TBMI+TBMIL-1  ENTER SUBFUNCTION PROCESSOR
 
 TBMI     BSS    0
          LOC    1
 
+         AX5    12          (ICMS) - INVALIDATE CACHE
          BX3    -X0*X5      MODE FLAG
          EQ     BMI1        ENTER *ICMS* PROCESSOR
 
 TBMIL    BSS    0
          LOC    *O
 
 BMI1     SB4    X3-1        CHECK FOR INVALID MODE
          GT     B4,B0,HNG   IF INVALID MODE
          SA7    A5          COMPLETE FUNCTION
          SB4    B7+FLSW
          ERRNZ  ECSW-FLSW-2  CODE ASSUMES *ECSW*=*FLSW*+2
          LX3    1           MODE*2
          SA1    B4+X3       GET *FLSW*/*ECSW*
          BX2    -X0*X1      CM/EM FL
          LX2    6
          LX1    24
          AX1    36          CM/UEM RA
          LX1    6
          ZR     X3,BMI2     IF CM MODE
          TLX1   3,UESC      RELATIVE UEM ADDRESS
          MX3    1
          BX1    X3+X1       SET EXTENDED MEMORY FLAG
          TLX2   3,UESC      UEM FL
 BMI2     IC     X1,X2,703B  TELL EI TO INVALIDATE CACHE BLOCK
          EQ     MTRX        EXIT
 CCAM     SPACE  4
***       CCAM - CHANGE CONTROL POINT ASSIGNMENT.
*         ENTERED FROM *TIOM*.
*
*         ENTRY
*T, OR    12/  CCAM,1/J,1/R,1/M,1/A,1/,7/ CP,12/  EJTO,24/
*         J      IF SET, INDICATES EJT ORDINAL NOT REQUIRED AT NEW
*                CONTROL POINT.
*         R      IF SET, (SCHEDULER CALL TO RESERVE CONTROL POINT) SET
*                JOB ADVANCE AND INTERLOCK FLAGS FOR JOB SPECIFIED BY
*                EJT ORDINAL *P* AND SET EJT ORDINAL IN CP AREA WORD
*                *TFSW*.  THE FUNCTION WILL BE REJECTED IF THE JOB
*                ADVANCE OR INTERLOCK FLAGS ARE ALREADY SET OR IF THE
*                CP IS OCCUPIED (EJT ORDINAL ALREADY SET).
*         M      IF SET, REJECT CHANGE IF MOVE FLAG SET.  IF NOT SET
*                AND THE MOVE FLAG IS SET AT THE NEW CP/PCP, A *PRLM*
*                FUNCTION WILL BE ENTERED IN THE OUTPUT REGISTER AFTER
*                THE CHANGE.  THIS OPTION WILL BE IGNORED IF THE
*                REQUEST IS TO CLEAR AN ALTERNATE CP/PCP ASSIGNMENT.
*         A      IF SET AND *CP* .NE. 0, SET ALTERNATE CP/PCP
*                ASSIGNMENT TO CP OR PCP *CP*.  IF SET AND *CP* .EQ. 0,
*                CLEAR ALTERNATE CP/PCP ASSIGNMENT.
*         CP     NEW CONTROL POINT OR PSEUDO-CONTROL POINT NUMBER.
*                PSEUDO-CONTROL POINT IS ALLOWED ONLY IF *A* IS SET.
*                IF ZERO, CLEAR ALTERNATE CP/PCP ASSIGNMENT (*A* MUST
*                BE SET).
*         EJTO   EJT ORDINAL TO SET.  IGNORED IF *R* OPTION NOT SET.
*
*         EXIT
*T,  OR   12/  0,48/  PARAMETERS
*         PARAMETERS = 0 IF CONTROL POINT CHANGE MADE
*         PARAMETERS = ENTRY PARAMETERS IF CHANGE NOT MADE
*
*         HANG CONDITIONS -
*                *J* OPTION SPECIFIED WITH *M* OR *A* OPTION.
*                *R* OPTION SPECIFIED WITHOUT *J* OPTION.
*                *R* OPTION SPECIFIED WITH *M* OR *A* OPTION.
*                CHANGE IS BEING MADE TO CURRENT CONTROL POINT.
*                CHANGE TO AN INVALID CONTROL POINT.
*                CHANGE IS BEING MADE AND ALTERNATE CP/PCP ASSIGNMENT
*                  IS IN EFFECT.
*                ALTERNATE CP/PCP SPECIFIED (*A* OPTION) IS THE CURRENT
*                  ALTERNATE CP/PCP.
*                INVALID CP/PCP SPECIFIED WITH *A* OPTION.
*                INVALID EJT ORDINAL SPECIFIED WITH *R* OPTION.
 
 
          PPR    CCAM
 
*         SET OLD AND NEW CP/PCP POINTERS AND VALIDATE CALL PARAMETERS.
 
          SA3    A5-B1
          BX7    X1          SET REJECT RESPONSE
          LX1    0-44
          MX0    -4
          SX6    741040B     VALID OPTION COMBINATIONS MASK
          BX0    -X0*X1      OPTIONS
          LX2    -24
          SB3    X0+59-17
          SB5    X2          OLD CP/PCP ADDRESS
          LX6    B3
          SX0    37600B
          SX4    7600B
          AX5    36-7
          PL     X6,HNG      IF INVALID OPTION COMBINATION
          LX3    -36+7
          BX5    X0*X5       NEW CP ADDRESS OR PCP NUMBER * 200B
          BX6    X3          SAVE INPUT REGISTER
          SB4    X5          SAVE NEW CP OR PCP NUMBER * 200B
          BX3    X4*X3
          SB6    X5          NEW CP ADDRESS IF CP
          SB7    X3          CALLING CP ADDRESS
          LX1    59-44-0+44
          SB3    A2          SAVE *ACPP* ADDRESS
          TX0    X5-200B,-SCA
          NG     X1,CCA1     IF ALTERNATE CP/PCP REQUEST
          ZR     B6,HNG      IF NEW CP NUMBER NOT VALID
          PL     X0,HNG      IF NEW CP NUMBER NOT VALID
          NE     B5,B7,HNG   IF ALTERNATE CP/PCP ASSIGNMENT
          BX6    -X4*X6
          BX6    X6+X5       SET NEW CP NUMBER IN INPUT REGISTER
          EQ     CCA3        CHECK CHANGE TO CURRENT CP
 
 CCA1     NZ     B6,CCA2     IF NOT CLEAR ALTERNATE CP/PCP ASSIGNMENT
          SB4    B7
          SB6    B7
 CCA2     NG     X0,CCA3     IF NOT SET ALTERNATE PCP ASSIGNMENT
          TX3    X0-200B,-PCM2
          TB6    X0,PCPA     SET PCP ADDRESS
          PL     X3,HNG      IF INVALID PCP NUMBER
 CCA3     EQ     B5,B6,HNG   IF CHANGING TO CURRENT CP/PCP
 
*         CHECK ACTIVITY AT NEW CP/PCP.  SINCE THE *CCAM* FUNCTION MAY
*         HAVE BEEN STORAGE MOVABLE FOLLOWING A PREVIOUS EXIT TO *REJ*,
*         EXIT MUST BE MADE TO *CSM* IF A REJECT RESPONSE IS TO BE
*         RETURNED TO THE CALLER.
 
          SA2    B6+TFSW     GET EJT ORDINAL
          LX6    36-7        RESTORE INPUT REGISTER
          LX1    59-47-59+44
          MX0    12
          LX5    X1,B1
          BX3    X0*X2       NEW CP EJT ORDINAL
          PL     X5,CCA4     IF NOT RESERVE CP OPTION
          LX1    59-35-59+47
          SA4    B6+STSW
          NZ     X3,CSM      IF EJT ORDINAL PRESENT
          BX4    X0*X4       PP ACTIVITY
          BX3    X0*X1       SPECIFIED EJT ORDINAL
          NZ     X4,CSM      IF PP ACTIVITY AT CONTROL POINT
          LX1    59-47-59+35
          ZR     X3,HNG      IF NO EJT ORDINAL SPECIFIED
          BX2    X3+X2       SET EJT ORDINAL IN *TFSW*
 CCA4     NZ     X3,CCA5     IF EJT ORDINAL IS PRESENT
          TX4    B6,-SCA
          ZR     X4,CCA5     IF CHANGE TO SYSTEM CP
          PL     X1,CSM      IF EJT ORDINAL REQUIRED
 CCA5     LX3    12
          CX4    X3,EJT      CONVERT EJT ORDINAL TO OFFSET
          MX0    1
          TA4    X4+JSNE,EJT
          LX4    59-6        CHECK JOB ADVANCE FLAG AT NEW CP
          BX0    X0*X5       EXTRACT RESERVE CP OPTION
          PL     X4,CCA6     IF JOB ADVANCE NOT SET
          BX3    X1
          LX3    59-44-59+47
          PL     X3,CSM      IF NOT ALTERNATE CP/PCP OPTION
          EQ     B6,B7,CCA6  IF CLEAR ALTERNATE CP/PCP ASSIGNMENT
          BX3    X6
          AX3    42
          SX3    X3-3R1RO
          NZ     X3,CSM      IF NOT *1RO*
 CCA6     BX4    X4+X0       SET JOB ADVANCE IF RESERVE CP OPTION
          LX4    59-0-59+6
          BX3    X0*X4
          LX1    59-44-59+47
          NG     X3,CSM      IF JOB INTERLOCK SET AND RESERVE CP OPTION
          SA3    TFPL-1+LA1CP  GET *1CP* PLD POINTER
          BX4    X0+X4       SET JOB INTERLOCK IF RESERVE CP OPTION
          LX4    0-59
 
*         SUSPEND PROCESSING IF *1CP* NOT ACCESSIBLE OR INCORRECT CPU
*         ASSIGNMENT ON DUAL CPU CACHE MACHINE.
 
          SX5    X3+
          ZR     X5,CCA16    IF *PLD* BEING MODIFIED
          SA3    B6+STSW     NEW CP STATUS
          TNO    /MONITOR/CCA7,NDCPC  IF NOT DUAL CPU CACHE MACHINE
          SX0    A0+
          LX7    X3,B1
          NZ     X0,CCA7     IF MONITOR MODE IN CPU 1
          NG     X3,CCA7     IF NEW CP NOT ACTIVE IN EITHER CPU
          NG     X7,/DCP/SAX IF NEW CP IN CPU 1, SET ALTERNATE EXCHANGE
 
*         UPDATE NEW CP/PCP PP ACTIVITY AND CP/PCP ASSIGNMENT.
 
 CCA7     SX0    1
          LX0    48-0
          IX7    X3+X0       INCREMENT PP COUNT
          EQ     B6,B7,CCA8  IF CLEAR ALTERNATE CP/PCP REQUEST
          SA7    A3+         UPDATE PP COUNT
 CCA8     SX7    B6+
          PL     X1,CCA10    IF NOT ALTERNATE CP/PCP REQUEST
          EQ     B6,B7,CCA10 IF CLEAR ALTERNATE CP/PCP REQUEST
          TX3    B4-200B,-SCA
          NG     X3,CCA9     IF NOT SET ALTERNATE PCP ASSIGNMENT
          SX7    B7+         SET CALLING CP FOR FUNCTION PROCESSING
 CCA9     SX3    1
          LX3    23-0
          BX7    X7+X3       SET ALTERNATE CP/PCP FLAG
 CCA10    SX3    B4
          LX3    48-7        SET NEW CP/PCP NUMBER
          BX7    X3+X7
          SX3    B6
          LX3    24          SET NEW CP/PCP ADDRESS
          BX7    X7+X3
          LX1    59-45-59+44
          SA7    B3          UPDATE *ACPP*
          PL     X1,CCA11    IF NOT TO REJECT CHANGE ON STORAGE MOVE
 
*         CHECK REJECT ON STORAGE MOVE.  THIS MUST BE DONE AFTER *STSW*
*         AND *ACPP* HAVE BEEN UPDATED TO INTERLOCK WITH *MTR* STORAGE
*         MOVE PROCESSING. IF THE FUNCTION IS REJECTED, THE ENTRY
*         CONDITIONS MUST BE RESTORED.
 
          NE     B5,B7,CCA11 IF ALTERNATE CP/PCP ASSIGNMENT
          SA3    CMCL
          SX7    B4
          AX7    7           NEW CP/PCP NUMBER
          AX3    48
          IX3    X3-X7
          ZR     X3,CCA15    IF MOVE REQUEST FOR NEW CP/PCP
 
*         UPDATE NEW CP/PCP STATUS FOR *R* OPTION AND UPDATE OLD CP/PCP
*         PP ACTIVITY.
 
 CCA11    SA3    B5+STSW     GET OLD CP/PCP STATUS
          BX7    X2
          SA7    A2          UPDATE *TFSW*
          BX7    X4
          SA7    A4          UPDATE EJT ENTRY
          LX1    59-44-59+45
          SA6    A5-B1       UPDATE INPUT REGISTER
          PL     X1,CCA12    IF NOT ALTERNATE CP/PCP REQUEST
          NE     B6,B7,CCA13 IF NOT CLEAR ALTERNATE CP/PCP REQUEST
 CCA12    IX6    X3-X0       DECREMENT OLD CP/PCP PP ACTIVITY
          SA6    A3+
          BX3    X6
 
*         CALL *1CP* TO COMPLETE FUNCTION PROCESSING.
 
 CCA13    SA1    B3          GET *ACPP* PARAMETERS
          BX6    X3          SAVE *STSW* FOR DUAL CPU CACHE CHECK
          SB4    X5          SET *1CP* PLD ENTRY ADDRESS
          SX5    B0          SET *CCAM* RESPONSE
          MX0    24
          TX7    B6+FLSW+1,-NCME  SET FL CONTROL WORD ADDRESS
          LX0    12
          LX7    24
          BX1    X0*X1       SET CP/PCP NUMBER AND CP ADDRESS
          SB3    CCA14       SET *EFP* RETURN ADDRESS
          BX7    X7+X1
          EQ     EFP         EXECUTE *1CP*
 
*         CHECK JOB ACTIVITY AT OLD CONTROL POINT.
 
 CCA14    SB7    B5+         SET OLD CP TO CHECK
          TX0    B5,-SCA
          SB3    PPRX        SET *JAV* RETURN ADDRESS
          TNO    /DCP/CCA,DCPC  IF DUAL CPU CACHE MACHINE
          NG     X0,JAV      IF OLD JOB NOT SYSTEM CP OR PCP
          EQ     PPRX        EXIT
 
*         RESTORE ENTRY CONDITIONS FOR CHANGE REJECTED ON STORAGE
*         MOVE.
 
 CCA15    SA3    B6+STSW     RESET PP ACTIVITY
          SA5    A5          GET OUTPUT REGISTER
          SX1    B5          RECONSTRUCT ORIGINAL *ACPP*
          SX6    B5
          LX1    24
          BX6    X6+X1
          LX1    24-7
          BX6    X1+X6
          SA6    B3          UPDATE *ACPP*
          IX6    X3-X0       DECREMENT PP ACTIVITY
          UX7,B0 X5          CLEAR FUNCTION CODE
          SA6    A3          UPDATE PP ACTIVITY
          EQ     CSM         CHECK STORAGE MOVE AND EXIT
 
*         REJECT REQUEST WHEN *1CP* NOT ACCESSIBLE.
 
 CCA16    SB5    PPRX        SET EXIT ADDRESS
          EQ     REJ         REJECT REQUEST
 CDAM     SPACE  4,15
***       CDAM - CHECK MASS STORAGE DEVICE ACTIVITY.
*
*         ENTRY
*T, OR    12/  CDAM,12/  EQ,36/
*         EQ     MASS STORAGE EST ORDINAL.
*
*         EXIT
*T, OR    12/  0,12/  ST,36/  0
*         ST     DEVICE ACTIVITY COUNT.
*
*         HANG CONDITIONS -
*
*         EST ORDINAL DOES NOT POINT TO MASS STORAGE DEVICE.
 
 
          PPR    CDAM,,,FEX
 
          AX1    36          POSITION EST ORDINAL
          CX2    X1,EST
          TA2    X2+EQDE,EST
          PL     X2,HNG      IF NOT MASS STORAGE
          MX0    -12
          BX6    -X0*X2      EXTRACT MST POINTER
          SX7    B1
          LX6    3           SET MST ADDRESS
          SA4    X6+DILL
          LX4    -24         EXTRACT *PUT* ORDINAL
          BX4    -X0*X4
          ZR     X4,CDA1     IF NOT BUFFERED DEVICE
          SA3    /BUFIO/MSTA
          LX4    PUTLS       FORM *PUT* INDEX
          BX3    X6-X3
          ZR     X3,CDA2     IF BUFFER ASSIGNMENT IN PROGRESS
          TA1    X4+UNCT,PUT
          LX1    -12         CHECK CURRENT *CB* PRESENT
          BX7    -X0*X1
          ZR     X7,PPR1     IF DEVICE INACTIVE
 CDA1     SA2    A4-B1
          ERRNZ  DALL+1-DILL  CODE DEPENDS ON VALUE
          MX0    -6
          LX2    -48         EXTRACT REQUEST COUNT
          BX7    -X0*X2
 CDA2     LX7    36          POSITION RESPONSE
          SA7    A5
          EQ     PPRX        RETURN
 CEFM     SPACE  4,30
***       CEFM - CHANGE ERROR FLAG.
*
*         ENTRY
*T, OR    12/  CEFM,1/E,11/ EF,12/ EJTO,24/ JSN
*         E      IF SET, CHANGE ERROR FLAG ON JOB SPECIFIED BY
*                *EJTO* FIELD.
*                IF CLEAR, CHANGE ERROR FLAG ON CONTROL POINT TO
*                WHICH PP IS ASSIGNED.
*         EF     ERROR FLAG TO SET.
*         EJTO   EJT ORDINAL OF JOB IF *E* SET.
*         JSN    JOB SEQUENCE NAME IF *E* OPTION SELECTED.
*
*         EXIT
*T, OR    12/ 0,3/ JS,9/ ST,36/
*         JS = CPU STATUS FROM *STSW* IF ERROR FLAG SET ON JOB AT
*              CONTROL POINT.
*         ST = 0, IF ERROR FLAG SET ON SPECIFIED JOB.
*         ST = 1, IF JOB IS MOVING (FOR *E* = 1 OPTION ONLY).
*         ST = 3, IF JOB SPECIFIED BY *EJTO* NOT FOUND.
*
*         HANG CONDITIONS -
*
*         1.  IF JOB AT CONTROL POINT WITH EJT ORDINAL = 0.
*         2.  *EJTO* = 0 FOR *E* = 1 OPTION.
*         3.  *EJTO* EXCEEDS MAXIMUM EJT ORDINAL FOR *E* = 1 OPTION.
*         4.  CLEARING ZERO ERROR FLAG.
*         5.  CHANGING ERROR FLAG AT SYSTEM CP OR UNOCCUPIED USER CP.
*         6.  SETTING AN INCORRECT ERROR FLAG.
 
 
          PPR    CEFM
 
          SB6    CEF1        SET RETURN ADDRESS FOR *CPE*
          LX1    59-47
          SB5    -B1         FLAG EJT ORDINAL NOT SPECIFIED
          TPL    X1,(/DCP/CPE,DCP,/MONITOR/CEF1)  IF SET ERROR AT CP
          MX1    24
          LX5    -24
          MX0    -12
          BX2    X1*X5       SPECIFIED JSN
          BX6    -X0*X5      SPECIFIED EJT ORDINAL
          LX5    24
          TX3    X6,-EJTM
          ZR     X6,HNG      IF NO EJT ORDINAL SPECIFIED
          PL     X3,HNG      IF EJT ORDINAL EXCEEDS MAXIMUM
          CX3    X6,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA3    X3+JSNE,EJT GET EJT ENTRY
          MX7    2
          LX7    36-58       STATUS = JOB NOT FOUND
          SX4    7600B
          BX1    X1*X3       JOB SEQUENCE NUMBER IN EJT
          LX3    7-1
          BX2    X2-X1
          BX0    X4*X3
          NZ     X2,PPR1     IF JOB NOT FOUND
          SA3    A3+SCHE-JSNE  GET JOB CONTROL POINT NUMBER
          SA2    A3+PRFE-SCHE  GET EJT ERROR FLAG
          BX6    X3
          SX0    X0-EXJS*200B
          LX6    59-34
          SB5    B7+         INDICATE SETTING ERROR IN EJT
          SA6    CEFC        SAVE JOB TERMINATION STATUS
          NZ     X0,CEF2     IF JOB NOT AT CONTROL POINT
          LX3    -12+7
          BX3    X4*X3
          SB5    -2          INDICATE EJT ORDINAL SPECIFIED ON CALL
          SB7    X3          SET CONTROL POINT ADDRESS
          TNO    /DCP/CPE,DCP  IF DUAL-CPU IN USE
 
*         SET ERROR AT CONTROL POINT.
*         ENTERED HERE FOR *ABTM* AND *CHGM*.
*         (B6) = 0 IF *ABTM*.
*         (B6) .LT. 0 IF *CHGM*.
*         (B5) .GT. 0 IF *ABTM* OR *CHGM*.
 
 CEF1     SA4    B7+TFSW     GET EJT ORDINAL
          MX0    12
          BX4    X0*X4
          ZR     X4,HNG      IF SYSTEM CP OR UNOCCUPIED USER CP
          LX4    12
          CX3    X4,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA3    X3+SCHE,EJT
          MX6    -2
          LX3    0-33
          BX3    -X6*X3
          SX6    B0
          ERRNZ  NOTM        CODE ASSUMES *NOTM* = 0
          IX6    X6-X3
          SA6    CEFC
          SA2    B7+STSW
          SB5    B5+B1
          PL     B5,CEF2     IF NOT EJT ORDINAL CALL
          SX7    B1          STATUS = JOB MOVING
          SA3    CMCL        CHECK FOR STORAGE MOVE
          LX7    36
          BX3    X0*X3
          LX3    12+7        CPA ADDRESS FOR STORAGE MOVE
          SB4    X3
          EQ     B4,B7,PPR1  IF JOB MOVING
 CEF2     MX0    11          GET ERROR FLAG
          LX0    46-59
          BX7    X0*X5       NEW ERROR FLAG
          BX3    X0*X2       OLD ERROR FLAG
          IX6    X7+X3
          ZR     X6,HNG      IF CLEARING ZERO ERROR FLAG
          BX1    -X0*X2
          ZR     X7,CEF4     IF CLEARING ERROR FLAG
          LX2    59-56
          IX0    X7-X3       NEW - OLD
          AX3    36
          BX6    X7
          LX6    -36
          SB4    X3-RSET
          SX3    X6-MXET
          PL     X3,HNG      IF ILLEGAL ERROR FLAG
          ZR     B4,CEF6     IF AN UNPROCESSED *RSET* PRESENT
          GT     B5,CEF4     IF *ABTM* OR SETTING ERROR IN EJT
          SA3    CEFB
          SB4    X6
          LX3    B4,X3
          SA4    CEFC
          BX4    X3*X4
          NG     X4,CEF6     IF ODET/RRET/OKET AT END OF JOB
          PL     X2,CEF4     IF NO SUB-CP ACTIVE
          BX6    X6-X6
          AX7    36
          SA6    A5          CLEAR OUTPUT REGISTER
          EQ     SEF         SET ERROR FLAG
 
 CEF4     NG     X0,CEF5     IF OLD ERROR FLAG .GT. NEW ERROR FLAG
          BX6    X1+X7       STORE NEW ERROR FLAG
          SA6    A2
 CEF5     ZR     X7,PPR1     IF ERROR FLAG CLEARED
          SX5    B1+
          LX5    36-0        SET TO CLEAR ROLLOUT CPU STATUS
          NE     B5,B7,.DCPM IF NOT SETTING ERROR FLAG IN EJT ENTRY
 CEF6     BX7    X7-X7       CLEAR OUTPUT REGISTER
          SA7    A5
          EQ     PPRX        EXIT
 
 
 CEFB     BSS    0           MASK FOR ODET / RRET / OKET
          POS    60-ODET
          VFD    1/1
          POS    60-RRET
          VFD    1/1
          POS    60-OKET
          VFD    1/1
          VFD    $/0
 
 CEFC     CON    0           JOB TERMINATION STATUS
 CHGM     SPACE  4,10
***       CHGM - CONDITIONALLY HANG PP.
*
*         ENTRY
*T, OR    12/  CHGM,12/PA,12/EF,12/,12/
*         PA     ADDRESS IN PP WHERE ERROR CONDITION DETECTED.
*         EF     ERROR FLAG TO SET AT CONTROL POINT OR ZERO.
*
*         EXIT   IF SYSTEM DEBUG MODE ENABLED
*T, OR    12/  HLTM,48/
*
*         EXIT   IF SYSTEM DEBUG MODE DISABLED
*T, OR    60/0
 
 
          PPR    CHGM,,,DCP
 
          SA5    A5          GET CURRENT OUTPUT REGISTER
          MX6    1           SET MOVABLE FUNCTION FLAG
          LX6    56-59
          BX5    X5+X6
          BX6    X5
          SA6    A5
          SB3    CHG1
          EQ     ACB         ASSIGN COMMUNICATIONS BUFFER
 
 CHG1     ZR     X1,CHG9     IF NO BUFFER ASSIGNED
          MX0    -12
          LX5    24          GET PP PROGRAM ADDRESS
          BX6    -X0*X5
          LX6    36
          SA4    B7+TFSW     GET EJT ORDINAL
          LX4    12
          BX2    -X0*X4
          ZR     X2,CHG2     IF NO EJT ENTRY
          CX4    X2,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA3    X4+JSNE,EJT GET EJT ENTRY
          MX2    24
          BX2    X2*X3       JOB SEQUENCE NUMBER IN EJT
          LX2    36
          BX6    X6+X2
          TA3    X4+SCLE,EJT GET JOB SERVICE CLASS
          MX2    6
          BX3    X2*X3
          LX3    6
          BX6    X3+X6
 CHG2     LX5    -24+12      GET FUNCTION BEING PERFORMED
          MX7    -7
          BX7    -X7*X5
          SX7    X7-CHGM
          ZR     X7,CHG3     IF *CHGM* FUNCTION
          SX7    3           FLAG PP HUNG
          LX7    48
          IX6    X6+X7
          LX6    -36         SET PP PROGRAM ADDRESS TO ZERO
          BX6    X0*X6
          LX6    36
          EQ     CHG4        SET UP *1MA* CALL
 
 CHG3     SX7    B1
          LX5    -12+36
          BX2    -X0*X5
          LX7    48
          ZR     X2,CHG4     IF NO ERROR FLAG
          SX2    X2-SWET
          IX6    X6+X7       FLAG JOB BEING ABORTED
          NZ     X2,CHG4     IF NOT *SWET* ERROR, ASSUME JOB STEP ABORT
          IX6    X6+X7       SET JOB ABORTED
 
*         SET UP *1MA* REQUEST.
 
 CHG4     SA6    X1+B1       STORE PARAMETER IN COMMUNICATIONS BUFFER
          SA4    A5-B1       GET PP INPUT REGISTER
          BX6    X4
          SA2    A4+B1       GET PP OUTPUT REGISTER
          BX7    X2
          SA6    A6+B1       STORE IN COMMUNICATIONS BUFFER
          SA7    A6+B1
          SA4    A2+B1       GET FIRST WORD OF MESSAGE BUFFER
          BX6    X4
          SA6    A7+B1       STORE IN COMMUNICATIONS BUFFER
          SB4    -B1         SET NO QUEUEING
          SX6    B7          SAVE CONTROL POINT ADDRESS
          SA6    CHGB
          TB7    0,SCA       USE SYSTEM CONTROL POINT
          SA2    CHGA        GET *1MA* REQUEST
          BX6    X2
          IX6    X6+X1       ADD IN COMMUNICATIONS BUFFER ADDRESS
          SX1    0
          SB3    CHG5
          EQ     APQ         ASSIGN *1MA* TO SYSTEM CONTROL POINT
 
 CHG5     NZ     X1,CHG6     IF *1MA* ASSIGNED
          SB3    CHG6
          SX2    PQ          QUEUE THE REQUEST
          EQ     AQR         ASSIGN QUEUE REQUEST
 
 CHG6     SA1    CHGB        RESTORE CONTROL POINT ADDRESS
          SA5    A5
          MX7    -7
          LX5    12
          BX7    -X7*X5      GET FUNCTION BEING PERFORMED
          SX7    X7-CHGM
          SB7    X1+
          SB5    PPRX
          NZ     X7,HNG2     IF NOT *CHGM*
          SA4    SSTL        CHECK FOR SYSTEM DEBUG ENABLED
          SB5    CHG7
          LX4    59-13
          SA5    A5
          PL     X4,HNG2     IF SYSTEM DEBUG MODE ENABLED
 
*         PROCESS AS *HLTM* WHEN SYSTEM DEBUG IS DISABLED.
 
          SA7    A5+         CLEAR OUTPUT REGISTER
          EQ     CHG8        CHECK FOR ERROR FLAG PRESENT
 
 CHG7     SX1    HLTM        CHANGE CHGM FUNCTION TO HLTM FUNCTION
          LX1    48
          MX2    12
          BX7    -X2*X5
          BX7    X7+X1
          SA7    A5+
 CHG8     LX5    0-24
          MX2    -11
          TB4    B7,-SCA
          ZR     B4,PPRX     IF SYSTEM CONTROL POINT DO NOT SET ERROR
          BX5    -X2*X5      GET ERROR FLAG
          LX5    36          POSITION ERROR FLAG
          ZR     X5,PPRX     IF NO ERROR FLAG PRESENT, RETURN
          SB6    -1          FLAG DO NOT STORE OUTPUT REGISTER
          EQ     CEF1        CHANGE ERROR FLAG
 
 CHG9     MX1    1           HAVE PP REISSUE FUNCTION
          BX7    X5+X1
          EQ     PPR1        RETURN STORING OUTPUT REGISTER
 
 CHGA     VFD    18/0L1MA,6/,12/7,24/
 CHGB     CON    0           SAVE OF CONTROL POINT ADDRESS
 CKSM     SPACE  4
***       CKSM - CHECKSUM SPECIFIED AREA.
*         THE SPECIFIED AREA IS CHECKSUMMED, AND THE RESULT IS COMPARED
*         TO THE FIRST WORD OF THE MESSAGE BUFFER.  THE RESULT IS
*         ALSO RETURNED TO THE CALLER.
*
*         ENTRY
*T, OR    12/ CKSM,7/,17/ WC,7/,17/ FWA
*         WC     WORD COUNT.
*         FWA    RELATIVE FIRST WORD ADDRESS.
*
*T, MB    60/  CHECKSUM COMPARE VALUE
*
*         EXIT
*T, OR    12/  0,36/  0,12/  STATUS
*           STATUS = 0, IF CHECKSUM COMPARE SUCCESSFUL.
*
*T, MB    60/  CALCULATED CHECKSUM
 
 
          PPR    CKSM,PMR,CKS,FEX
 CPRM     SPACE  4,20
***       CPRM - ASSIGN, LOAD, OR IDLE A CPP.
*
*         ENTRY
*T, OR    12/ CPRM,12/ FFFF,12/ 0,12/ 0,12 PPPP
*         FFFF   SUBFUNCTION.
*                0 = ASSIGN CPP.
*                1 = ASSIGN CPP AND LOAD PP RESIDENT.
*                2 = RETURN CPP.
*         PPPP   CIO BARREL FROM WHICH CPP IS TO BE ASSIGNED
*                (SUBFUNCTION 0 AND 1).
*                2 = BARREL 0 (CPP 0 THRU 4).
*                3 = BARREL 1 (CPP 5 THRU 11).
*                (SUBFUNCTION 2).
*                NUMBER OF CPP TO RETURN.
*
*T, MB    60/ IR
*         IR     INPUT REGISTER FOR CPP BEING ASSIGNED
*                (SUBFUNCTION 0 AND 1).
*                NOT USED FOR SUBFUNCTION 2.
*
*T, PW    60/ PW
*         PW     THIS WORD WILL BE PLACED INTO MB OF THE
*                ASSIGNED CPP (SUBFUNCTION 0 AND 1).
*                NOT USED FOR SUBFUNCTION 2.
*
*         EXIT
*T, OR    12/,12/ ST,12/ RC,12/,12/
*         ST     STATUS (SUBFUNCTION 0 AND 1).
*                ADDRESS OF THE ASSIGNED CPP INPUT REGISTER.
*                ZERO IF CPP NOT ASSIGNED, RC FIELD INDICATES REASON.
*                STATUS (SUBFUNCTION 2).
*                ZERO INDICATES CPP DROPPED, RC FIELD NOT VALID.
*                ONE INDICATES ERROR IN REQUEST, RC INDICATES REASON.
*         RC     RESPONSE CODE.
*                0 = CPP ASSIGNED.
*                1 = CPP NOT ASSIGNED (SUBFUNCTION 2 ONLY).
*                2 = CPP NOT PRESENT.
*                3 = CPP NOT AVAILABLE.
*                4 = INCORRECT CPP NUMBER.
*                5 = INCORRECT CIO BARREL NUMBER.
*                6 = MAXIMUM NUMBER (NPPCP) OF PP-S ALREADY ASSIGNED.
*                7 = IF PERIPHERAL LIBRARY LOCKED (SUBFUNCTION 2 ONLY).
*               10 = PP PROGRAM NOT FOUND  (SUBFUNCTION 2 ONLY).
 
 
          PPR    CPRM
 
          TNO    /CPP/CPR,CPP  IF CPP-S ARE DEFINED
          SX7    10002B      SET ERROR CODE ST=1, RC=2
          AX1    36+1
          NZ     X1,CPRM1    IF SUBFUNCTION 2
          SX7    B1+B1
 CPRM1    LX7    24-0
          EQ     /MONITOR/MTRC  STORE (OR) AND EXIT MONITOR MODE
 CSTM     SPACE  4
***       CSTM - CLEAR STORAGE.
*         NOTE - CSTM CLEARS STORAGE FROM LWA TO FWA.
*
*         ENTRY
*T, OR    12/ CSTM,3/ 0,1/S,1/E,1/R,18/ WC,24/ FWA
*         WC     WORD COUNT OF AREA TO BE CLEARED.
*         FWA    FIRST WORD ADDRESS OF AREA TO BE CLEARED.
*         S = 1, IF REQUEST IS SPECIAL FOR *RSTM* FROM *MTR*.
*             0, IF REQUEST IS NORMAL MONITOR FUNCTION.
*         E = 0, IF FWA IS A CM ADDRESS.
*           = 1, IF FWA IS A USER ECS ADDRESS.
*         R = 0, IF FWA IS AN ABSOLUTE ADDRESS.
*           = 1, IF FWA IS A CP RELATIVE ADDRESS.
*         IF WC IS ZERO FOR A CM REQUEST, AREAS TO BE CLEARED ARE
*         SPECIFIED BY A LIST IN THE MESSAGE BUFFER.
*         LIST IS TERMINATED BY A ZERO WORD.
*         LIST FORMAT NOT APPLICABLE FOR ECS REQUEST.
*
*         FORMAT OF LIST ENTRY-
*T, MB    18/0,18/ WC,24/ FWA
*
*         IF S=1, THE REQUEST IS CLEAR STORAGE TO BE RELEASED BY
*         THE JOB.  THE FWA AND WORD COUNT IS TO BE DERIVED FROM
*         THE *RSTM* REQUEST IN MB+5.  UPON COMPLETION, THE *RSTM*
*         REQUEST (PLUS THE COMPLETION FLAG) IS TO BE RESTORED
*         IN THE CALLER-S OUTPUT REGISTER SO IT MAY BE COMPLETED.
*
*         NOTE - WHEN CLEARING ECS, WC IS THE NUMBER OF *UEBS*
*                WORD BLOCKS TO CLEAR,AND FWA IS
*                THE ACTUAL ADDRESS/*UEBS*.
*
*         EXIT
*T, OR    60/ 0
 
 
          PPR    CSTM,,CST
 
          AX2    24
          LX1    59-44
          SB7    X2+         SET CP/PCP ADDRESS
          TNG    X1,(/MCE/CST,MCE,/MONITOR/HNG)  IF SPECIAL *RSTM* CALL
          LX1    44-59
 
*         REENTRY FROM */MCE/CST* AFTER SETUP OF *CSTM* PARAMETERS.
 
 CST0     BX4    X1          CHECK FOR VALID OPTIONS
          MX0    -12
          SB4    X1          SET FWA
          LX4    59-43
          TNG    X4,(/MONITOR/PMR,UEC,/MONITOR/HNG)  IF ECS REQUEST
          BX6    X5
          LX5    -24
          SB3    X5+         (B3) = 0 IF LIST PRESENT
          LX5    24
          LX4    59-42-59+43
          PL     X4,CST3     IF NOT RELATIVE ADDRESSES
 
*         CONVERT TO ABSOLUTE ADDRESSES.
 
          SA2    B7+FLSW     READ RA AND FL
          BX1    X5
          BX3    -X0*X2
          LX2    12
          BX6    -X0*X2      EXTRACT NFL
          MX0    -RMSK
          AX2    RSHF+12
          BX2    -X0*X2      RA/100
          LX6    6           NFL
          SB5    X6
          MX0    36
          LX3    6
          SB4    X3          (B4) = FL
          LX2    6           (X2) = RA
          NZ     B3,CST2     IF NOT LIST OPTION
          SA1    A5+B1       READ FIRST LIST WORD
 CST2     SX7    X1
          IX6    X7+X2       CONVERT RELATIVE ADDRESS TO ABSOLUTE
          NG     X6,HNG      IF BAD FWA
          BX3    X0*X1
          BX6    X3+X6
          LX1    -24
          PL     X7,CST2.1   IF NOT NFL ADDRESS
          SB6    X7
          SB6    -B6
          GT     B6,B5,HNG   IF BEYOND NFL
          SB6    X1
          SB6    B6+X7
          LE     B6,B0,CST2.2  IF WITHIN NFL
          EQ     HNG         HANG PP
 
 CST2.1   SB6    X1
          SB6    B6+X7
          GT     B6,B4,HNG   IF BEYOND FL
 CST2.2   LX1    24
          NZ     B3,CST3     IF NOT LIST OPTION
          SA6    A1          STORE ABSOLUTE ADDRESS
          SA1    A1+1
          NZ     X1,CST2     IF MORE WORDS IN LIST
 CST3     ZR     B3,PMR      IF LIST OPTION
          AX1    24
          BX5    X6
          SB4    X1-100B-1
          SB5    X1-1
          PL     B4,PMR      IF TOO MANY WORDS FOR MONITOR MODE
          NG     B5,HNG      IF ILLEGAL WORD COUNT
          MX2    -24         CLEAR STORAGE
          SX1    X1+
          BX2    -X2*X5      FWA
          SB3    PPR1        *CSM* RETURN ADDRESS
          TJP    (/MCE/CST5,MCE,/CME/CSM,CME,/0CME/CSM)  CLEAR
 DCPM     SPACE  4,25
***       DCPM - DROP CPU.
*         IT SHOULD BE NOTED THAT THE EXCHANGE PACKAGE IS NOT
*         IN THE USER,S CP AREA AT THE TIME THE OUTPUT
*         REGISTER IS CLEARED.  TO MAKE SURE THE PACKAGE IS
*         AVAILABLE ANOTHER *CPUMTR* MONITOR FUNCTION SHOULD
*         BE DONE SUCH AS *RCLM*.
*
*         ENTRY
*T, OR    12/  DCPM,11/0,1/F,12/,12/,12/
*         F = 1, TO CLEAR CPU STATUS PRESENT AT ROLLOUT.
*
*         EXIT
*T, OR    12/  0,3/ ST,9/0,36/
*         ST     CPU STATUS FROM STSW.
*
*         NOTE   WHEN ENTERING THE *DCPM* PROCESSOR FROM ANOTHER
*                ROUTINE THE FOLLOWING ENTRY CONDITIONS MUST BE SET -
*
*                (B6) .LT. 0 IF NOT TO WRITE OUTPUT REGISTER.
*                (B6) = 0 IF TO RETURN *DPPM* FUNCTION IN OUTPUT
*                       REGISTER.
*                (B6) = 1 IF TO CLEAR OUTPUT REGISTER.
*                (B6) .GT. 1 IF TO RETURN CURRENT CPU STATUS IN OUTPUT
*                          REGISTER.
*                (X5 BIT 36) = 1 IF TO CLEAR CPU STATUS AT ROLLOUT.
 
 
          PPR    DCPM,,,DCP
 
*         SET FUNCTION RETURN.  ENTERED HERE FROM *CEFM*, *ROCM*, AND
*         *RPNM*.
 
          SA1    B7+STSW     READ STATUS
          MX0    3
          BX7    X0*X1       CPU STATUS
          GT     B6,B1,DCP1  IF TO RETURN CPU STATUS
          SX7    B0+
          EQ     B6,B1,DCP1  IF TO CLEAR OUTPUT REGISTER
          SX7    DPPM+4000B  RETURN *DPPM* FUNCTION
 DCP1     NG     B6,DCP2     IF NOT TO WRITE OUTPUT REGISTER
          TX2    10B,SP
          SX3    A5
          MX4    -18
          BX3    -X4*X3
          IX2    X3-X2
          PL     X2,DCP2     IF NOT PP REQUEST
          LX7    -12
          SA7    A5          WRITE OUTPUT REGISTER
 
*         CLEAR CPU STATUS.
 
 DCP2     SX3    B1
          LX5    25-36       POSITION CLEAR ROLLOUT CPU STATUS FLAG
          LX3    25-0
          BX7    -X0*X1      CLEAR CPU STATUS
          BX3    X3*X5
          BX7    -X3*X7      CLEAR ROLLOUT CPU STATUS IF SELECTED
          BX1    X0*X1       CPU STATUS ON ENTRY
          SA7    A1          WRITE STATUS
 
*         CHECK ENTRY CPU STATUS.
 
          ZR     X1,DCP4     IF NULL STATUS ON ENTRY
          PL     X1,DCP6     IF ACTIVE JOB
          LX1    1
          NG     X1,DCP4     IF *I* STATUS
          LX0    X1,B1
          SA3    B7+CWQW     READ *CWQW*
          SX6    1
          LX6    46-0
          BX6    X3+X6       SET NO DRIVER RECALL
          NG     X0,DCP2.1   IF *X* STATUS
          MX7    58
          MX4    42
          LX7    48-0
          BX6    X4*X6       CLEAR *WQ* LINKAGE
          SX1    WQRL
          BX6    X7*X6       CLEAR CPU SLICE ACTIVE AND RECALL FLAGS
          SA6    A3          UPDATE *CWQW*
          TJP    (/DCP/DCP,DCP,/MONITOR/DCP3)
 
 DCP2.1   SA6    A3          UPDATE *CWQW* FLAGS
          SA3    B7+CRCW     READ *CRCW*
          SX7    B0
          SX1    RQRL
          SA7    A3          CLEAR *RQ* PARAMETERS
          MX4    -12
 
*         REMOVE *WQ* OR *RQ* ENTRY IF *W* OR *X* STATUS.
 
 DCP3     ZR     X1,DCP4     IF END OF QUEUE
          SA2    X1          FIND LINK TO DELETED ENTRY
          SX6    A3
          BX1    -X4*X2
          BX0    X6-X1
          NZ     X0,DCP3     IF NOT FOUND
          BX2    X4*X2       REPLACE LINK TO DELETED ENTRY
          BX3    -X4*X3
          BX6    X2+X3
          SA6    A2
 DCP4     TX2    A5-1,-FP
          SB3    PPRX        *JAV* RETURN ADDRESS
          ZR     X2,PPRX     IF CALL BY *MTR*
          EQ     JAV         ADVANCE JOB
 
*         JOB ACTIVE IN THIS CPU - START NEW JOB.
 
 DCP6     TX1    A5-1,-FP
          SB3    BNJ1        *JAV* RETURN ADDRESS
          ZR     X1,BNJ1     IF CALL BY *MTR*
          EQ     JAV         CHECK FOR JOB ADVANCE
 DEQM     SPACE  4,20
***       DEQM - DROP EQUIPMENT.
*
*         RELEASE EQUIPMENT FROM JOB ASSIGNMENT.
*
*         ENTRY
*T, OR    12/  DEQM,12/  EQ,12/,12/  EJT,12/
*         EQ     EST ORDINAL (IF 4000B + EQ, EJT IS PRESENT).
*         EJT    EJT ORDINAL TO RELEASE EQUIPMENT FROM.
*
*         EXIT
*T, OR    60/  0
*         COUNTER IN *EACW* DECREMENTED, IF EQUIPMENT WAS
*         ASSIGNED TO CALLER AND IS RELEASED.
*
*         HANG CONDITIONS -
*
*         ILLEGAL EST ORDINAL.
*         EQUIPMENT NOT ASSIGNED TO CALLER (OR ALTERNATE EJT ORDINAL).
 
 
          PPR    DEQM
 
          LX5    24
          MX2    -9
          BX2    -X2*X5      EST ORDINAL
          MX0    -12
          TX3    X2,-ESTL
          PL     X3,HNG      IF INVALID EST ORDINAL
          CX3    X2,EST      CONVERT EST ORDINAL TO OFFSET
          LX5    59-47-24
          TA3    X3+EQAE,EST READ EQUIPMENT ASSIGNMENT WORD
          LX1    36
          TX4    B7,-SCA
          BX6    X0*X3
          NG     X5,DEQ1     IF ALTERNATE EJT SPECIFIED
          MX1    12
          ZR     X4,DEQ1     IF PP AT SYSTEM CONTROL POINT
          SA1    B7+TFSW     GET JOB EJT
 DEQ1     LX1    12
          BX4    X1-X3       CHECK EQUIPMENT ASSIGNMENT
          SX2    B1
          BX4    -X0*X4
          NZ     X4,HNG      IF EQUIPMENT ASSIGNED ELSEWHERE
          LX2    48
          SA6    A3
          NG     X5,PPR1     IF RELEASE FROM ALTERNATE EJT
          SA4    B7+EACW
          IX6    X4-X2       DECREMENT EQUIPMENT ASSIGNED COUNT
          SA6    A4
          EQ     PPR1        RETURN
 DFMM     SPACE  4,30
***       DFMM - PROCESS DAYFILE MESSAGE.
*
*         ENTRY
*T, OR    12/  DFMM,12/  BC,6/,6/  MO,24/
*T, MB    42/, 18/ADDR
*         BC     BYTE COUNT OF MESSAGE.  THE PP WILL BE HUNG IF
*                *BC* TRANSLATES TO WORD COUNT GREATER THAN 5 FOR
*                CODED MESSAGES AND 6 FOR BINARY MESSAGES.
*                FOR *BMCN* THE (BC) MUST TRANSLATE TO A WORD COUNT
*                THAT IS .LE. 60.
*                BC = 0, SET BUFFER IN *1DD* INPUT REGISTER BUSY.
*         MO     MESSAGE OPTION (SEE *PPCOM* FOR LIST OF OPTIONS).
*                BIT 5 OF *MO* SET INDICATES THAT THE CALLING PP
*                CANNOT DUMP THE DAYFILE BUFFER.
*                BIT 4 OF *MO* SET WILL CAUSE THE DAYFILE BUFFER TO
*                BE INTERLOCKED FOR PROCESSING BY THE CALLING PP.
*
*                MESSAGE BUFFER CONTAINS UP TO AND INCLUDING 5 WORDS
*                OF MESSAGE DATA (6 WORDS FOR BINARY MESSAGE).
*         ADDR   FOR *BMCN* THIS IS THE CENTRAL MEMORY ADDRESS WHERE
*                THE *BML* ENTRY IS LOCATED.
*
*         INTERMEDIATE PROCESSING (USED ON BUFFER BUSY AND FULL)
*T, OR    12/  CDBM,12/  BC,6/,6/  MO,12/  CP+SF,12/  DI
*         CP  =  CONTROL POINT ADDRESS.
*         SF  =  0 TO WAIT FOR 1 SECTOR OF SPACE IN DAYFILE BUFFER.
*             =  1 TO WAIT UNTIL PP DUMP BUFFER NOT BUSY.
*         DI     DAYFILE INDEX.
*                0 = JOB DAYFILE.
*                1 = MASTER DAYFILE.
*                2 = ACCOUNT DAYFILE.
*                3 = ERRLOG DAYFILE.
*                4 = MAINLOG DAYFILE.
*
*         EXIT
*T, OR    12/  0,12/  BC,6/,6/  MO,12/  0,12/  0
*         MESSAGE COMPLETELY PROCESSED.
*
*T, OR    12/  0,36/,12/  BUSY
*         BUSY = 0, IF BUFFER WAS SET BUSY ON BC = 0 REQUEST.
*
*T, OR    12/  0,12/  BC,6/,6/  MO,12/  LN,12/  DI
*         PP MUST CALL *1DD* TO DUMP THE BUFFER.
*         LN     LENGTH OF MASS STORAGE ERROR PROCESSOR AND DIRECT
*                CELLS TO BE SAVED.
*         DI     DAYFILE INDEX.
*                0 = JOB DAYFILE.
*                1 = MASTER DAYFILE.
*                2 = ACCOUNT DAYFILE.
*                3 = ERRLOG DAYFILE.
*                4 = MAINLOG DAYFILE.
*
*         NOTE THAT IF AN ALTERNATE PSEUDO-CONTROL POINT ASSIGNMENT IS
*         PRESENT, THE ONLY OPTIONS THAT CAN BE SPECIFIED ARE THOSE
*         THAT ISSUE MESSAGES TO THE SYSTEM DAYFILES WITH THE JSN
*         SUPPLIED BY THE CALLER.
*
*         HANG CONDITIONS -
*
*                MESSAGE LENGTH TOO LONG.
*                OPTION SELECTED IS NOT FOR SYSTEM DAYFILE WITH CALLER
*                  SUPPLIED JSN AND ALTERNATE PSEUDO-CONTROL POINT
*                  ASSIGNMENT IS PRESENT.
 
 
          PPR    DFMM
 
          AX2    24
          SB7    X2          SET CP/PCP ADDRESS
          SA2    DSSL        CHECK FOR DEADSTART IN PROGRESS
          SX6    A5+         SET DUMMY RA+1
          LX2    59-2
          PL     X2,DFM0     IF NOT DEADSTART IN PROGRESS
          TB7    SCA         ISSUE MESSAGE AT SYSTEM CONTROL POINT
 DFM0     SA6    RA1
          MX0    36          CLEAR BYTES 3 AND 4 OF OUTPUT REGISTER
          BX7    X0*X5
          AX1    36          POSITION BYTE COUNT
          SA7    A5+
          BX5    X7
          ZR     X1,DFM30    IF SET BUFFER BUSY REQUEST
          SB4    4
          SX7    16384/5+1
          SX4    X1+B4       BC+4
          IX6    X7*X4       (BC+4)*16384/5
          SX3    B4+B1       X3 = 5
          AX6    14          ((BC+4)*(16384/5))/16384 = (BC+4)/5
          SX2    X1-27
          SB6    X6          SET WORD COUNT
          SX4    A5+         SET MESSAGE ADDRESS - 1
          MX0    -4
          LX5    -24
          TX2    B7-200B,-SCA
          BX0    -X0*X5      CHECK MESSAGE DESTINATION
          NG     X2,DFM0.3   IF NOT ALTERNATE PCP ASSIGNMENT
          SX2    106014B     CALLER SUPPLIED JSN OPTIONS MASK
          SB3    X0+59-17
          LX2    B3
          PL     X2,HNG      IF NOT CALLER SUPPLIED JSN OPTION
 DFM0.3   SB3    X0-BMLN/10000B
          LX5    -36
          NG     B3,DFM1     IF NOT MAINTENANCE LOG (*BMLN* OR *BMCN*)
          SX2    X1-31
          ZR     B3,DFM1     IF *BMLN* FUNCTION
          SA2    A5+1
          SX4    X2-1        SET MESSAGE ADDRESS - 1
          SX2    X1-60*5+1
 DFM1     PL     X2,HNG      IF MESSAGE TOO LONG
          IX7    X6*X3       (BC+4)/5*5
          IX0    X1-X7       BC-((BC+4)/5*5) = -REMAINDER
          SX2    0           SET *DFMM* FLAG
          SA1    X4+B6
          NZ     B6,DFM2     IF WORD COUNT .NE. 0
          BX0    -X3         SET MASK INDEX FOR NULL MESSAGE
          SX6    B1          SET WORD COUNT
 
*         BEGIN PROCESSING COMMON TO *DFMM* AND *MSG* REQUESTS.
*
*         ENTRY  (X0) = MASK INDEX FOR LAST WORD OF MESSAGE.
*                (X1) = LAST WORD OF MESSAGE.
*                (X2) = 1/X,59/0 WHERE X = 1 IF *MSG* CALL.
*                (X4) = MESSAGE ADDRESS - 1.
*                (X5) = REQUEST.
*                (X6) = WORD COUNT OF MESSAGE.
 
 DFM2     BX7    X2+X4       COMBINE CALL FLAG WITH MESSAGE ADDRESS
          SA6    DMWC        SAVE WORD COUNT
          SA7    A6+B1
          ERRNZ  DMWC+1-DMMA MEMORY REFERENCE OUT OF ORDER
          SA3    X0+TMSK+5   FETCH EOM MASK
          MX4    -4
          BX7    X3*X1
          SX0    X6+B1       ADJUST WORD COUNT TO INCLUDE TIME
          LX5    -24         EXTRACT MESSAGE OPTION
          SA7    A7+B1
          ERRNZ  DMMA+1-DMLW MEMORY REFERENCE OUT OF ORDER
          BX3    -X4*X5
          MX1    12
          SB4    X3-TMPOL
          PL     B4,DFM8     IF ILLEGAL OPTION (DEFAULT TO 0)
          SA2    X3+TMPO
 DFM3     BX6    X2          SAVE ENTRY FROM MESSAGE OPTION TABLE
          LX5    24          SHIFT REQUEST WORD BACK
          SA6    DMPA
          NG     X2,DFM7     IF MESSAGE GOING TO JOB DAYFILE
          MX3    -6
          AX6    36
          BX6    -X3*X6
          SB6    X6          SET DAYFILE INDEX
          LX3    X6,B1       CALCULATE ABSOLUTE ADDRESS
          IX3    X3+X6
          TX6    X3-3,DP
          SA6    DDBA
          ERX3   X6          READ BUFFER POINTERS
 DFM4     SX7    B1
          IX4    X6+X7
          IX7    X7+X4
          ERX4   X4
          ERX1   X7          CHECK BUFFER STATUS
          SB4    X4          OUT POINTER
          LX1    59-1
          AX4    24          BUFFER LENGTH
          SB3    X3          IN POINTER
          ZR     X4,DFM16    IF ZERO LENGTH BUFFER
          SA7    DFPA
          PL     X1,DFM23    IF BUFFER INTERLOCKED
          SB5    B4-B3       OUT - IN
          LX3    59-35
          NG     X3,DFM24    IF MESSAGES WERE LOST
          LX3    35-59
          AX3    36          FIRST POINTER
          SB4    X0+B1       WORD COUNT INCLUDING JOB SEQUENCE NUMBER
          GT     B5,B0,DFM5  IF OUT .GT. IN
          SB5    X4+B5
 DFM5     TGE    B4,B5,(/CPP/DDB,CPP,/MONITOR/DDB)  IF NOT ENOUGH SPACE
          BX7    X5
          LX7    59-28
          PL     X7,DFM6     IF NO REQUEST TO SET BUFFER INTERLOCK
          SX7    B1
          LX1    1
          BX7    -X7*X1
          PL     X1,DFM23    IF DUMP IN PROGRESS
          LX7    1
          SA1    DFPA
          EWX7   X1          SET BUFFER INTERLOCK
 DFM6     SB4    X2          PREPROCESSOR ADDRESS
          SA1    TIML
          SA2    DMMA
          BX6    X1          TIME VALUE FOR MESSAGE
          SB5    X4          SET LIMIT
          BX4    X6
          JP     B4          EXIT TO PREPROCESSOR
 
 DFM7     TX4    B7,-SCA
          ZR     X4,DFM8     IF SYSTEM CONTROL POINT
          SA3    B7+FLSW
          MX1    12
          BX4    X1*X3
          ZR     X4,DFM16    IF NO NFL
          MX1    -RMSK
          LX1    12
          BX4    -X1*X3      EXTRACT RA
          AX4    6
          SX6    DAPN
          IX6    X4-X6
          ERX3   X6
          SA6    DDBA
          SX7    DAYN
          IX4    X4-X7       SET ABSOLUTE BUFFER ADDRESS
          SX3    X3
          LX4    36
          BX3    X4+X3       COMBINE BUFFER ADDRESS WITH IN POINTER
          SB6    B0+         SET DAYFILE INDEX FOR JOB DAYFILE
          EQ     DFM4        READ REMAINING BUFFER POINTERS
 
 DFM8     SA5    A5          REREAD REQUEST
          LX1    -24
          SA2    TMPO        CHANGE MESSAGE OPTION TO 0
          BX7    -X1*X5
          SA7    A5+
          LX5    -24
          EQ     DFM3        PROCESS NEW MESSAGE OPTION
 
*         ENTRY FOR MESSAGE WITH JOB SEQUENCE NUMBER IN MESSAGE.
*
*T MB     24/ JSN, 12/ NONZERO, 12/ NONZERO, 6/ , 6/ SC
*         JSN    JOB SEQUENCE NUMBER.
*         SC     JOB SERVICE CLASS.
 
 DFM9     SX1    B1
          IX0    X0-X1
          IX2    X1+X2       INCREMENT ADDRESS
          ERX1   X2          READ NEXT WORD
          MX7    -6
          BX7    -X7*X1      JOB SERVICE CLASS
          EQ     DFM12       STORE TIME
 
*         ENTRY FOR MESSAGE TO BINARY MAINTENANCE LOG.
 
 DFM10    SX7    X0+1        SET WORD COUNT FOR MESSAGE HEADER
          SA1    PDTL
          MX6    -36
          BX1    -X6*X1
          LX7    48
          BX6    X7+X1
 
*         ENTRY FOR MESSAGE WITH JOB SEQUENCE NUMBER FROM
*         CONTROL POINT AREA.
 
 DFM11    SA1    B7+TFSW     GET EJT ORDINAL
          MX4    -12
          LX1    12
          BX4    -X4*X1
          CX1    X4,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA1    X1+SCLE,EJT GET JOB SERVICE CLASS
          BX7    X1
          AX7    54
          SA1    A1+JSNE-SCLE  GET JOB SEQUENCE NUMBER
          NZ     X4,DFM12    IF EJT ORDINAL PRESENT
+         TX4    B7,-SCA
          NZ     X4,*        IF NOT SYSTEM CONTROL POINT
 
*         STORE TIME AND TRANSLATE JOB SERVICE CLASS.
 
 DFM12    SX4    B3          STORE TIME IN DAYFILE BUFFER
          IX4    X3+X4
          EWX6   X4
          MX4    24
          SB3    B3+B1       ADVANCE IN
          BX4    X4*X1
          SA1    TJSC+X7     GET JOB SERVICE CLASS TRANSLATION
          LX4    -12
          BX4    X4+X1
          NE     B3,B5,DFM13 IF IN .NE. LIMIT
          SB3    0           SET IN = FIRST
 
*         ENTRY FOR MESSAGE WITH NO JOB SEQUENCE NUMBER.
 
 DFM13    ZR     X0,DFM14    IF MESSAGE TRANSFER COMPLETE
          BX6    X4
          SX1    B3
          IX1    X3+X1
          SX0    X0-1        DECREMENT MESSAGE WORD COUNT
          EWX6   X1
          SB3    B3+B1       ADVANCE IN
          SX4    B1
          IX2    X2+X4
          ERX4   X2          READ NEXT WORD OF MESSAGE
          NE     B3,B5,DFM13 IF IN .NE. LIMIT
          SB3    0           SET IN = FIRST
          EQ     DFM13       CONTINUE TRANSFER
 
 DFM14    SA2    DMLW        STORE EOM
          BX7    X2
          SA2    DDBA        REREAD IN POINTER
          ERX3   X2
          AX3    18          CLEAR IN POINTER
          SX0    B3          SET IN
          LX3    18
          SB3    DFM16       SET RETURN FROM *DDD*
          BX6    X3+X0
          EWX7   X1
          EWX6   X2
          SX6    B1
          IX6    X6+X2
          ERX1   X6
          BX4    X1
          SX1    X1
          AX4    24
          IX7    X0-X1       IN - OUT
          PL     X7,DFM15    IF IN .GT. OUT
          IX7    X7+X4       ADD BUFFER LENGTH
 DFM15    BX6    X4-X7       CHECK BUFFER THRESHOLD
          AX6    6
          ZR     X6,DDD      IF BUFFER FULL
 DFM16    TX4    B7,-SCA     CHECK JOB ISSUING MESSAGE
          SA2    DMPA
          LX2    -18         POSITION POST PROCESSOR ADDRESS
          BX7    X7-X7
          SB4    X2
          LX2    18+1
          ZR     X4,DFM20    IF JOB AT SYSTEM CONTROL POINT
          SA1    DMMA        GET *MSG* CALL FLAG
          JP     B4          EXIT TO POST PROCESSOR
 
 DFM17    SX3    10B
          EQ     DFM19       CHANGE MESSAGE REQUEST
 
 DFM18    SB0    0
          SX3    CPON/10000B
 
*         CHANGE MESSAGE REQUEST.
 
 DFM19    LX5    -24         POSITION OUTPUT REGISTER
          MX7    55
          SA4    DMWC        READ WORD COUNT
          BX5    X7*X5       REMOVE CURRENT REQUEST
          SA2    X3+TMPO     READ MESSAGE OPTION TABLE
          BX7    X5+X3       INSERT NEW MESSAGE OPTION
          MX1    12
          LX7    24
          SX0    X4+B1
          BX5    X5+X3
          SA1    RA1
          EWX7   X1          REWRITE RA+1
          SA7    MSGB        UPDATE POSSIBLE *X* STATUS COPY
          EQ     DFM3        PROCESS NEXT DAYFILE
 
 DFM20    PL     X2,PPR1     IF MESSAGE NOT SPECIFIED FOR *MS1W*
          SB0    0
 
*         STORE MESSAGE AT *MS1W* OF CONTROL POINT.
 
 DFM21    MX0    -12
          SA3    DMMA        RETRIEVE MESSAGE ADDRESS
          LX5    59-23
          PL     X3,DFM22    IF *DFMM* CALL
          SX1    1
          NG     X5,DFM22    IF CONTROL STATEMENT MESSAGE
          SA4    B7+ACLW     CHECK USER MESSAGE LIMIT
          LX1    36
          BX2    X4
          LX4    12
          AX4    48
          ZR     X4,DFM22    IF UNLIMITED USER
          IX7    X2-X1       DECREMENT USER MESSAGE LIMIT
          SA7    A4
 DFM22    BX4    -X3         KEEP MSG INDICATOR
          SX5    B1
          IX1    X3+X5       NEXT WORD
          ERX2   X1          READ NEXT WORD
          BX6    X2
          JP     TMSG+1      MOVE MESSAGE VIA *MSG* PROCESSOR
 
*         IF CALLING PP CAN DUMP THE BUFFER, REJECT THE REQUEST VIA
*         *CDBM*.  OTHERWISE, SIMULATE A COMPLETED REQUEST.
 
 DFM23    SA2    DMMA        CHECK REQUEST
          SX4    B6
          MX1    1
          NG     X2,DFM23.1  IF *MSG* CALL
          BX5    X4+X5
          JP     DDB2        CHANGE REQUEST TO *CDBM*
 
*         RESTORE ORIGINAL REQUEST AND SET *X* STATUS.
 
 DFM23.1  SA1    MSGB        GET ORIGINAL REQUEST
          BX6    X1
          SA1    RA1         GET RA+1 ADDRESS
          EWX6   X1
          EQ     SXS         SET *X* STATUS
 
*         DAYFILE MESSAGES WERE RECENTLY DISCARDED BECAUSE THE
*         CALLING PP COULD NOT DUMP THE DAYFILE BUFFER.  THIS ROUTINE
*         PUTS AN INFORMATIVE MESSAGE IN THE BUFFER, IF ROOM EXISTS.
 
 DFM24    SX0    X0+DFMAL+1  TEST IF ROOM FOR ERROR MESSAGE
          LX3    35-59       REPOSITION BUFFER POINTERS
          SB5    B4-B3
          AX3    36          FIRST POINTER
          SB4    X0+B1
          GT     B5,B0,DFM25 IF OUT .GT. IN
          SB5    X4+B5
 DFM25    TGE    B4,B5,(/CPP/DDB,CPP,/MONITOR/DDB)  IF NOT ENOUGH SPACE
          MX6    1
          SB5    X4          SET LIMIT
          BX6    -X6*X1
          LX1    59-0-59+1
          PL     X1,DFM23    IF DUMP IN PROGRESS
          LX6    1-59
          SA1    DFPA        SET BUFFER INTERLOCK
          EWX6   X1
          SA4    DFMA        JOB SEQUENCE NAME FOR CODED DAYFILES
          SX4    X2-DFM10    CHECK FOR MESSAGE TO MAINLOG
          SA1    TIML        TIME LINE FOR CODED DAYFILES
          NZ     X4,DFM25.1  IF NOT MAINLOG
          SX4    4           SET MAINLOG WORD COUNT
          SA1    PDTL
          LX4    48
          BX1    X1+X4
          SA4    DFMB        JOB SEQUENCE NAME FOR BINARY DAYFILE
 DFM25.1  SX4    B3+         STORE TIME
          IX4    X3+X4
          BX6    X1
          EWX6   X4
          SA4    A4          REREAD JOB SEQUENCE NAME
          SB3    B3+B1       ADVANCE IN
          NE     B3,B5,DFM26 IF IN .NE. LIMIT
          SB3    B0
 DFM26    SX1    B3          WRITE JOB SEQUENCE NUMBER TO BUFFER
          BX6    X4
          IX1    X1+X3
          EWX6   X1
          SA1    A4+B1       ERROR MESSAGE
          SB3    B3+B1       ADVANCE IN
          NE     B3,B5,DFM27 IF IN .NE. LIMIT
          SB3    0
 DFM27    SX4    B3          WRITE ERROR MESSAGE TO BUFFER
          BX6    X1
          IX4    X3+X4
          SA1    A1+B1       GET NEXT WORD OF ERROR MESSAGE
          SB3    B3+B1       ADVANCE IN
          NE     B3,B5,DFM27.1  IF IN .NE. LIMIT
          SB3    B0
 DFM27.1  EWX6   X4          WRITE FIRST WORD OF MESSAGE TO BUFFER
          SX4    B3
          BX6    X1
          IX4    X3+X4
          SA1    DDBA
          EWX6   X4          WRITE SECOND WORD OF MESSAGE
          SX0    B1
          IX0    X0+X1
          ERX1   X1          CLEAR *MESSAGE LOST* FLAG
          MX6    1
          LX1    59-35
          BX6    -X6*X1
          SB3    B3+B1       ADVANCE IN
          NE     B3,B5,DFM28 IF IN .NE. LIMIT
          SB3    B0
 DFM28    LX6    35-59
          SA1    DDBA        REREAD *IN* POINTER
          SX4    B3          SET *IN*
          AX6    12
          LX6    12
          BX6    X4+X6
          ERX4   X0          RESTORE *LIMIT*
          EWX6   X1
          SX1    B1
          IX0    X0+X1
          AX4    24
          ERX1   X0
          MX6    1
          LX1    59-1
          LX5    59-28
          BX6    X1+X6
          NG     X5,DFM29    IF REQUEST TO SET BUFFER INTERLOCK
          LX6    1-59
          EWX6   X0          CLEAR BUFFER INTERLOCK
 DFM29    SA1    DMWC        RESTORE WORD COUNT
          LX5    28-59
          SX0    X1+B1       ADJUST WORD COUNT TO INCLUDE TIME
          EQ     DFM6        PROCESS MESSAGE
 
*         SET BUFFER BUSY FOR *1DD* DIRECT CALL.
 
 DFM30    SA1    A5-B1       READ INPUT REGISTER
          SX3    X1
          NZ     X3,DFM31    IF NOT JOB DAYFILE
          SA3    B7+FLSW     GET RA
          MX2    -RMSK
          AX3    RSHF
          BX2    -X2*X3      EXTRACT RA/100B
          LX2    6
          SX3    DAPN-2      SET INTERLOCK ADDRESS
          IX3    X2-X3
          EQ     DFM32       CONTINUE PROCESSING
 
 DFM31    LX2    X3,B1       SET INTERLOCK ADDRESS
          IX2    X2+X3
          TX3    X2-3+2,DP
 DFM32    ERX1   X3
          MX4    -3
          BX6    -X4*X1
          BX5    X6-X4
          SX4    5
          SX7    B1+
          NZ     X5,PPR1     IF BUFFER ALREADY DUMPED
          BX6    -X4*X1      SET BUFFER BUSY, CLEAR *1DD* CALLED FLAG
          BX7    X7-X7
          EWX6   X3
          EQ     PPR1        CLEAR OUTPUT REGISTER
 
 DFMA     DATA   10H**ERROR**.  JOB SEQUENCE NUMBER
          DATA   C*MESSAGES LOST.*  ERROR MESSAGE
 DFMAL    EQU    *-DFMA      ERROR MESSAGE LENGTH - 1
 
 DFMB     DATA   10H  SYS S.    SYSTEM JOB JAME
          VFD    12/DM0406,12/DS0114,36/0
          BSSZ   DFMB+DFMAL-*  FILL REST OF MESSAGE
 DMWC     CON    0           MESSAGE WORD COUNT
 DMMA     CON    0           MESSAGE ADDRESS
 DMLW     CON    0           LAST WORD OF MESSAGE
 DMPA     CON    0           PROCESSOR ADDRESS
 DFPA     CON    0           BUFFER POINTER ADDRESS
 TMPO     SPACE  4,10
**        TMPO - TABLE OF MESSAGE PROCESSING OPTIONS.
*
*         INDEXED BY MESSAGE OPTION (MO).
*
*T,       6/  DF,12/,6/  DI,18/  PP,18/  PA
*         DF  =  DESTINATION FLAGS.
*                BITS 0 - 3 = RESERVED.
*                BIT  4 = *MS1W* FLAG FOR SYSTEM CONTROL POINT.
*                BIT  5 = JOB DAYFILE FLAG.
*         DI  =  DAYFILE INDEX.
*                0 = JOB DAYFILE.
*                1 = MASTER DAYFILE.
*                2 = ACCOUNT DAYFILE.
*                3 = ERRLOG DAYFILE.
*                4 = MAINLOG DAYFILE.
*         PP  =  POST PROCESSOR ADDRESS.
*         PA  =  PROCESSOR ADDRESS.
 
 
 TMPO     BSS    0
 
          VFD    6/20B       (00B) - *MS1W* AND JOB/SYSTEM DAYFILES
          VFD    12/
          VFD    6/MSDY+1
          VFD    18/DFM18,18/DFM11
          VFD    6/0         NMSN - JOB/SYSTEM DAYFILES, NOT *MS1W*
          VFD    12/
          VFD    6/MSDY+1
          VFD    18/DFM17,18/DFM11
          VFD    6/0         JNMN - SYSTEM DAYFILE WITH JSN IN MESSAGE
          VFD    12/
          VFD    6/MSDY+1
          VFD    18/MTRP,18/DFM9
          VFD    6/60B       CPON - *MS1W* AND JOB DAYFILE
          VFD    12/
          VFD    6/0
          VFD    18/DFM21,18/DFM13
          VFD    6/0         ERLN - ERRLOG
          VFD    12/
          VFD    6/ELDY+1
          VFD    18/MTRP,18/DFM11
          VFD    6/0         ACFN - ACCOUNT FILE
          VFD    12/
          VFD    6/ACDY+1
          VFD    18/MTRP,18/DFM11
          VFD    6/0         EJNN - ERRLOG WITH JSN IN MESSAGE
          VFD    12/
          VFD    6/ELDY+1
          VFD    18/MTRP,18/DFM9
          VFD    6/0         AJNN - ACCOUNT FILE WITH JSN IN MESSAGE
          VFD    12/
          VFD    6/ACDY+1
          VFD    18/MTRP,18/DFM9
          VFD    6/40B       (10B) - USED INTERNALLY BY *CPUMTR*
          VFD    12/
          VFD    6/0
          VFD    18/MTRP,18/DFM13
          VFD    6/40B       CDON - JOB DAYFILE
          VFD    12/
          VFD    6/0
          VFD    18/MTRP,18/DFM13
          VFD    6/0         MDON - SYSTEM DAYFILE ONLY
          VFD    12/
          VFD    6/MSDY+1
          VFD    18/MTRP,18/DFM11
          VFD    6/0         I1FN - USER OPTION 1
          VFD    12/
          VFD    6/MSDY+1
          VFD    18/DFM18,18/DFM11
          VFD    6/0         I2FN - USER OPTION 2
          VFD    12/
          VFD    6/MSDY+1
          VFD    18/DFM18,18/DFM11
          VFD    6/0         I3FN - USER OPTION 3
          VFD    12/
          VFD    6/MSDY+1
          VFD    18/DFM18,18/DFM11
          VFD    6/0         BMLN - BINARY MAINTENANCE LOG
          VFD    12/
          VFD    6/MLDY+1
          VFD    18/MTRP,18/DFM10
          VFD    6/0         BMCN - BML WITH MESSAGE IN ALT. BUFFER
          VFD    12/
          VFD    6/MLDY+1
          VFD    18/MTRP,18/DFM10
 TMPOL    EQU    *-TMPO
 TMSK     SPACE  4,10
**        TMSK - TABLE OF MESSAGE TERMINATION MASKS.
 
 
 TMSK     BSS    0
          VFD    60/0
          VFD    12/-0,48/0
          VFD    24/-0,36/0
          VFD    36/-0,24/0
          VFD    48/-0,12/0
          VFD    60/-0
 TJSC     SPACE  4,10
**        TJSC - TABLE OF JOB SERVICE CLASS TRANSLATIONS.
*
*         ONE WORD ENTRIES INDEXED BY JOB SERVICE CLASS.
*T        12/ SPACES, 24/ 0, 6/ SC, 6/ ., 12/ SPACES
*         SC     SERVICE CLASS CHARACTER TRANSLATION.
 
 
 TJSC     BSS    0
 .1       SET    1
 .A       DUP    MXSC
 .2       MICRO  .1,1,$"NMDS"$
 .B       IFC    NE,$".2"$$
          VFD    12/2H  ,24/0,6/1H".2",18/3H.
 .1       SET    .1+1
 .B       ELSE
          STOPDUP
 .B       ENDIF
 .A       ENDD
 DDB      SPACE  4,15
**        DDB - DUMP DAYFILE BUFFER.
*
*         ENTRY  (DDBA) = FIRST / IN POINTER ADDRESS.
*                (DFPA) = BUFFER POINTER INTERLOCK ADDRESS.
*                (B6) = DAYFILE INDEX.
*                (B7) = CONTROL POINT ADDRESS.
*                (X5) = REQUEST.
*
*         USES   A - 1, 2, 4, 6, 7.
*                B - 3.
*                X - ALL.
*
*         CALLS  APQ, DDD, PPRX, PPR1, SXS.
 
 
 DDB      SA4    DDBA        CHECK BUFFER STATUS
          SX2    B1+B1
          IX6    X4+X2
          ERX1   X6
          SA2    DMMA        CHECK REQUEST
          LX1    59-0
          SX4    B6
          NG     X2,DDB4     IF *MSG* REQUEST
          BX5    X4+X5
          PL     X1,DDB2     IF DUMP IN PROGRESS
          SA2    DFPP
          MX0    -59
          LX2    59-0
          LX4    X2,B1
          PL     X2,DDB1     IF PP DUMP BUFFER IN USE
          BX2    X5          CHECK DUMP FLAG
          LX2    59-29
          BX7    X7-X7
          NG     X2,DDB2     IF PP CANNOT DUMP BUFFER
          BX7    -X0*X1
          LX7    1
          MX0    48
          EWX7   X6          SET DAYFILE BUFFER BUSY
          BX6    X0*X4
          SX4    65B         PARAMETER FOR PP *1DD* CALL
          MX0    -48
          SX3    A5-B1       PP INPUT REGISTER ADDRESS
          BX5    -X0*X5
          LX4    12
          BX6    X6+X3       SET PP DUMP BUFFER BUSY
          IX7    X5+X4
          SA6    A2
          SA7    A5          HAVE CALLING PP DUMP DAYFILE
          JP     PPRX        EXIT
 
 DDB1     BX7    X5          STORE PP OUTPUT REGISTER
          SB3    DDB2        SET RETURN FROM *DDD*
          SA7    A5
          JP     DDD         ATTEMPT TO DUMP DAYFILE DIRECT
 
*         CHANGE *DFMM* REQUEST TO *CDBM* IF THE CALLING PP CAN DUMP
*         THE DAYFILE BUFFER.  OTHERWISE, DISCARD REMAINING PORTION
*         OF MESSAGE, SET A *MESSAGE LOST* FLAG, AND SIMULATE A
*         COMPLETED REQUEST.
 
 DDB2     SX0    B7
          NZ     X1,DDB3     IF DUMP INITIATED
          SX0    X0+B1
 DDB3     LX0    12          POSITION *CDBM* SUBFUNCTION
          SX2    CDBM&DFMM
          LX5    59-29
          NG     X5,DDB3.1   IF CALLING PP CANNOT DUMP BUFFER
          LX5    29-59
          BX5    X5+X0
          LX2    48          CHANGE PP REQUEST TO *CDBM*
          BX7    X5-X2
          JP     PPR1        EXIT TO STORE PP OUTPUT REGISTER
 
 DDB3.1   SA1    DDBA        READ BUFFER POINTERS
          MX7    1
          ERX2   X1
          LX7    35-59
          BX7    X2+X7       SET *MESSAGE LOST* FLAG
          EWX7   X1          REWRITE POINTERS
          BX7    X7-X7       CLEAR OUTPUT REGISTER
          EQ     PPR1        EXIT
 
*         NOT ENOUGH SPACE IN BUFFER ON *MSG* REQUEST.
 
 DDB4     PL     X1,DDB8     IF DUMP IN PROGRESS
          SB3    DDB7        SET RETURN ADDRESS IF ACTIVE
          SA2    DD
          LX1    59-2-59+0
          SX0    B7          SAVE (B7)
          BX5    X6
          BX6    X2+X4
          NG     X1,DDB8     IF *1DD* ALREADY CALLED
          ZR     B6,DDB5     IF JOB DAYFILE
          TB7    0,SCA       SET SYSTEM CONTROL POINT
 DDB5     SB6    DDB6
          EQ     CAL         CHECK ACTIVITY LIMIT
 
 DDB6     MX2    1           SET *1DD* CALLED
          BX7    X1+X2
          LX7    2-59
          EWX7   X5          STORE BUFFER INTERLOCK WORD
          SB4    B0+         SET FOR DIRECTORY SEARCH
          SB3    DDB7
          EQ     APQ         ASSIGN PP REQUEST
 
 DDB7     SB7    X0          RESTORE (B7)
 
*         RESTORE ORIGINAL REQUEST AND SET *X* STATUS.
 
 DDB8     SA1    MSGB        GET ORIGINAL REQUEST
          BX6    X1
          SA1    RA1         GET RA+1 ADDRESS
          EWX6   X1
          EQ     SXS         SET JOB ON RECALL
 
 
 DDBA     CON    0           FIRST / IN POINTER ADDRESS
 DDD      SPACE  4,15
**        DDD - DUMP DAYFILE DIRECT.
*
*         ENTRY  (DDBA) = FIRST / IN POINTER ADDRESS.
*                (A5) = REQUEST ADDRESS.
*                (B3) = RETURN ADDRESS.
*                (B6) = DAYFILE INDEX.
*                (B7) = CONTROL POINT ADDRESS.
*
*         EXIT   (X1) = 0 IF DUMP NOT INITIATED.
*
*         USES   A - 1, 2, 4, 6, 7.
*                B - 3.
*                X - ALL.
*
*         CALLS  APQ.
 
 
 DDD      SA4    DDBA        CHECK BUFFER STATUS
          SX2    B1+B1
          MX6    -3
          IX0    X4+X2
          ERX3   X0
          BX6    -X6*X3
          BX1    X1-X1
          SX6    X6-3
          NZ     X6,RB3      IF BUFFER BUSY, INTERLOCKED, OR *1DD* CALL
          SX4    B6
          SA1    B7+TFSW     SET EJT ORDINAL
          MX2    -12
          LX1    12
          BX2    -X2*X1
          CX1    X2,EJT      CONVERT EJT ORDINAL TO OFFSET
          NZ     X2,DDD1     IF EJT ORDINAL PRESENT
+         TX2    B7,-SCA
          NZ     X2,*        IF NOT SYSTEM CONTROL POINT
 DDD1     TA2    X1+JSNE,EJT GET JOB ADVANCE FLAG
          BX1    X1-X1
          LX2    59-6
          SX7    B3          SAVE EXIT ADDRESS
          SX6    B6          SAVE (B6)
          NG     X2,RB3      IF JOB ADVANCE SET
          SA2    B7+STSW
          LX7    18
          LX2    59-24
          BX6    X6+X7
          SX7    B7          SAVE (B7)
          TNG    X2,(/CPP/DDD,CPP,/MONITOR/RB3)  IF ROLLOUT REQUESTED
 DDD2     SA2    DD          BUILD *1DD* CALL
          LX6    18
          BX6    X6+X7
          ZR     B6,DDD3     IF JOB DAYFILE
          TB7    0,SCA       SET SYSTEM CONTROL POINT
 DDD3     SX7    4           SET *1DD* CALLED FLAG
          SB3    DDD6
          SA6    T1          SAVE PARAMETERS
          SB6    DDD4
          BX6    X2+X4
          BX7    X3+X7
          EQ     CAL         CHECK ACTIVITY LIMIT
 
 DDD4     EWX7   X0          STORE BUFFER STATUS WORD
          SB4    B0          SET TO SEARCH DIRECTORY
          SB3    DDD5        SET RETURN ADDRESS
          EQ     APQ         ASSIGN PP
 
 DDD5     SX1    B1+         SET DUMP INITIATED
 DDD6     SA4    T1          RESTORE PARAMETERS
          SA5    A5          RESTORE REQUEST
          SB7    X4          RESTORE (B7)
          AX4    18
          SA2    DMMA
          SB6    X4          RESTORE (B6)
          AX4    18
          SB3    X4          RESTORE (B3)
          PL     X2,RB3      IF *DFM* CALL
          SA2    RA1
          ERX5   X2
          JP     B3          RETURN
 DLKM     SPACE  4
***       DLKM - DELINK TRACKS.
*
*         ENTRY
*T, OR    12/  DLKM,12/  EQ,12/  FT,12/  NT,12/  LT
*         EQ     EST ORDINAL
*                IF BIT 11 OF EQUIPMENT FIELD IS SET THEN SET THE
*                CHECKPOINT BIT FOR THIS EQUIPMENT UPON COMPLETION OF
*                THE REQUEST.
*         FT     TRACK ONTO WHICH NT IS LINKED.
*         NT     TRACK TO BE LINKED TO FT.
*         LT     LAST TRACK IN CHAIN TO DROP.
*
*         BIT 11 OF FT MUST BE CLEAR
*         ALL TRACKS FROM FT (NOT INCLUDING FT) TO LT ARE RELEASED.
*         NT IS LINKED TO FT.
*
*         EXIT.
*T, OR    36/  0,24/  PRU
*         PRU = NUMBER OF PRUS RETURNED TO THE SYSTEM.
*
*         NOTE - IF THE REQUEST IS FOR AN INDEPENDENT SHARED DEVICE,
*         THE MST, TRT, AND DIT ARE READ FROM THE DEVICE TO CM BY *1RU*
*         BEFORE THE DLKM IS ISSUED TO CPUMTR.
 
 
          PPR    DLKM,(/ISD/CHR,ISD,/LSPMMF/CME,LSPMMF,/MONITOR/PMR),DLK
,,FEX
 DPPM     SPACE  4,15
***       DPPM - DROP PP.
*
*         ENTRY
*T, OR    12/  DPPM,12/,12/,12/,12/
*
*         EXIT.
*T, IR    60/  0
*T, OR    60/  0
*
*         HANG CONDITIONS -
*
*         PP COUNT FIELD OF *STSW* IS ZERO UPON ENTRY.
*         ALTERNATE CONTROL POINT OR PSEUDO-CONTROL POINT ASSIGNMENT
*           PRESENT.
 
 
          PPR    DPPM,,,FEX
 
*         ENTRY FROM *JACM*, *RECM*, *RPPM*, *UADM*, AND *CPCX*.
 
          TX2    A5-1,-FP
          LX2    PPXES-PPCES
          MX0    -5
          TA2    X2+ACPP,FPX GET CP ASSIGNMENT
          TB5    A5-1,-SP
          GT     B5,B0,*     IF RA+1 ADDRESS (*CPCX* CALL)
          SA1    X2+STSW     GET CP STATUS
          SB7    X2          SET CP ADDRESS
          SX7    B1
          LX2    59-23
          LX0    48-0
          NG     X2,HNG      IF ALTERNATE CP/PCP ASSIGNMENT
          LX7    48-0
          BX3    -X0*X1      PP COUNT
          IX6    X1-X7       DECREMENT PP COUNT
          ZR     X3,HNG      IF PP COUNT ALREADY ZERO
          SA6    A1
          TNO    /MONITOR/DPP1,NDCPC  IF NOT DUAL CPU CACHE MACHINE
          SB4    DPP1        SET *CPA* RETURN ADDRESS
          TJP    (/DCP/CPA,DCPC,/MONITOR/HNG)  CHECK CPU SELECTION
 
 DPP1     SB3    /BUFIO/PCQ  SET EXIT TO PROCESS PSEUDO-PP REQUESTS
          TZR    B5,(/MONITOR/DPP4,BUFIO,/MONITOR/HNG)  IF PSEUDO-PP
          TX3    A5-1,-FPC
          NG     X3,DPP2     IF NOT CPP
          TJP    (/CPP/DPP,CPP,/MONITOR/HNG)  DROP CPP
 
*         RETURN PP TO POOL.
 
 DPP2     SA3    PPAL
          TX4    A5-1,-FP
          MX7    1
          AX4    PPCES       PP INDEX
          SB3    PPQ         SET EXIT TO PROCESS PP REQUESTS
          SX2    X4-12B
          SX1    35B
          LX7    -12
          NG     X2,DPP3     IF NOT SECOND BANK
          IX4    X1-X4
 DPP3     SB6    X4+
          AX7    B6,X7
          BX7    X7+X3       SET PP AVAILABLE BIT
          SX4    B1          INCREMENT FREE PP COUNT
          IX7    X7+X4
          SA7    A3+
 
*         CLEAR PP ASSIGNMENT.
 
 DPP4     SA4    A5-B1       SAVE AUTO RECALL BIT
          SX7    B0
          SA7    A2          CLEAR *ACPP*
          SA7    A5-B1       CLEAR INPUT REGISTER
          SA7    A5+B1       CLEAR MB
          SA7    A5          CLEAR OUTPUT REGISTER
          SX7    1S4
          SA7    IP          SET INCREASED PRIORITY FOR JOB
 
*         CHECK JOB STATUS.
 
          AX6    48
          LX4    59-41
          ZR     X6,JAV      IF NO CPU/PP ACTIVITY
          PL     X4,RB3      IF NOT AUTO RECALL FOR THIS PP
          AX6    9
          SX6    X6+B1
          SB6    B7+         SET EXCHANGE PACKAGE ADDRESS
          NZ     X6,RB3      IF NOT *I* STATUS
          EQ     RCC         RECALL CPU
 DTKM     SPACE  4
***       DTKM - DROP TRACKS.
*
*         ENTRY
*T, OR    12/  DTKM,12/  EQ,12/  TK,12/  SC,12/
*         EQ     EST ORDINAL
*                IF BIT 11 OF EQUIPMENT FIELD IS SET THEN SET THE
*                CHECKPOINT BIT FOR THIS EQUIPMENT UPON COMPLETION OF
*                THE REQUEST.
*                IF BIT 10 OF THE EQUIPMENT FIELD IS SET THE CALLER IS
*                RELEASING A TRACK CHAIN LOCAL TO ANOTHER MACHINE.
*         TK     FIRST TRACK
*         SC     SECTOR NUMBER
*
*         IF BIT 11 OF TK = 1, ALL TRACKS FROM TK TO END OF CHAIN ARE
*                DROPPED.
*         IF BIT 11 OF TK = 0, ALL TRACKS AFTER TK ARE DROPPED, AND
*                SC IS INSERTED IN TRACK BYTE.
*
*         EXIT
*T, OR    36/  0,24/  PRU
*         PRU = NUMBER OF PRUS RETURNED TO THE SYSTEM.
*
*         *PP HUNG.* WILL OCCUR FOR THE FOLLOWING CONDITIONS.
*         1)     EQUIPMENT NOT MASS STORAGE OR OUT OF EST.
*         2)     ECS ADDRESS OF MST SET WHEN NOT MULTI-MAINFRAME MODE.
*         3)     IF LAST SECTOR WRITTEN .GE. MAXIMUM SECTOR LIMIT.
*         4)     IF ATTEMPTING TO DROP TRACKS LOCAL TO ANOTHER MACHINE.
*                THIS IS DETECTED BY THE MRT BIT NOT BEING SET FOR
*                THE FIRST TRACK IN THE CHAIN BEING DROPED.
*         5)     THE TRACK IS BEYOND THE DEVICE TRACK LIMITS.
*
*         NOTE - IF THE REQUEST IS FOR AN INDEPENDENT SHARED DEVICE,
*         THE MST, TRT, AND DIT ARE READ FROM THE DEVICE TO CM BY *1RU*
*         BEFORE THE DTKM IS ISSUED TO CPUMTR.
 
 
          PPR    DTKM,(/ISD/CHR,ISD,/MONITOR/.DTKM),DTC,FEX
 
*         THIS FUNCTION WILL BE PERFORMED IN MONITOR MODE IF THE
*         THE FOLLOWING CONDITIONS ARE MET-
*
*         1)     DEVICE IS NOT MMF SHARED.
*         2)     *MST* IS NOT INTERLOCKED.
*         3)     REQUEST IS RESETTING EOI IN CURRENT EOI TRACK.
 
          LX1    59-35
          NG     X1,PMR      IF DROP ENTIRE CHAIN
          MX2    -9
          BX6    -X2*X1      EXTRACT EST ORDINAL
          CX4    X6,EST
          TA4    X4+EQDE,EST READ EST ENTRY
          SX7    -7777B
          BX4    -X7*X4      MST ADDRESS/10B
          LX4    3
          SA4    X4+SDGL     CHECK SHARED DEVICE STATUS
          LX4    -1
          MX3    -5
          NG     X4,PMR      IF DEVICE INTERLOCKED
          BX3    -X3*X4
          AX4    36-1
          ZR     X4,DTC1     IF NON-SHARED DEVICE
          TZR    X3,(/LSPMMF/CME1,LSPMMF,/MONITOR/PMR)  IF MST NOT READ
 DTC1     BX1    X1-X6       CLEAR EST ORDINAL
          LX1    35-25
          SA4    A4+TRLL-SDGL
          SX4    X4          PREVENT CARRY
          IX4    X4+X1
          SA3    X4          READ TRT WORD
          MX7    2           EXTRACT BYTE POSITION
          BX1    X7*X1
          LX1    2+2         BYTE * 4
          LX2    X1,B1       BYTE * 8
          IX1    X1+X2
          SB4    X1
          LX3    X3,B4
          NG     X3,PMR      IF EOI TRACK CHANGING
          UX1,B6 X5          SET TO INTERLOCK TRT
          SB3    /PROGRAM/DTC1  SET TO UPDATE EOI
          SX6    B2+         SAVE (B2)
          SB5    PPRX
          SA6    T1
          EQ     /PROGRAM/CTR1
 EATM     SPACE  4,25
***       EATM - ENTER/ACCESS EVENT TABLE.
*
*         ENTRY
*T, OR    12/  EATM,12/  FN,15/,21/  EVENT
*         FN     EEVS = ENTER EVENT.
*                SEIS = SET EVENT TABLE INTERLOCK.
*
*T, OR    12/  EATM,12/  FN,18/,1/0,17/  TINT
*         FN     UHSS = UPDATE 887 DISK SPIN-UP TIME.
*         TINT   TIME INTERVAL BEFORE NEXT EVENT ALLOWED.
*
*         EXIT
*         FN     EEVS, UHSS.
*T, OR    12/  0,12/  ST,36/
*         ST     0 IF REQUEST HONORED.
*                1 IF SUBFUNCTION NOT PROCESSED.
*
*         FN     SEIS.
*T, OR    12/  0,12/  COUNT,36/
*         COUNT  COUNT OF EVENTS IN TABLE PRESENTLY.
 
 
          PPR    EATM,,,FEX
 
          TA1    EVT         GET EVENT COUNT
          MX7    1
          BX3    X5          GET SUBFUNCTION
          MX0    -12
          LX3    24
          BX7    X7+X5
          BX3    -X0*X3
          BX6    -X0*X1      ISOLATE COUNT AND INTERLOCK BIT
          SB4    X3-UETMS
          LX6    59
          PL     B4,EAT4     IF UPDATE EVENT TIME REQUEST
          NG     X6,PPR1     IF INTERLOCK SET, REISSUE REQUEST
          NZ     X3,EAT2     IF SET INTERLOCK REQUEST
          SX3    MEVC        MAXIMUM NUMBER OF EVENTS
          MX0    -1
          IX3    X3-X6
          ZR     X3,EAT3     IF TABLE FULL
          AX4    X6,B1       SET TABLE INDEX
          SB4    12          SET SHIFT COUNT
          SX6    X6+B1       INCREMENT COUNT
          BX3    -X0*X6      SAVE EVEN OR ODD FLAG
          MX0    -21
          SX7    B0+
          ZR     X3,EAT1     IF COUNT EVEN
          SB4    36          SET SHIFT COUNT
 EAT1     BX5    -X0*X5
          SX6    B1+B1
          LX5    B4
          IX6    X1+X6
          LX0    B4
          SA6    A1          WRITE NEW COUNT
          TA2    X4,EVT
          BX6    X0*X2
          BX6    X5+X6
          SA6    A2+         WRITE EVENT TO TABLE
          EQ     PPR1        CLEAR OR
 
 EAT2     SX3    B1          SET INTERLOCK
          IX7    X1+X3
          SA7    A1+
 EAT3     LX6    36
          BX7    X6
          EQ     PPR1        RETURN EVENT COUNT
 
 EAT4     SA2    TSVT+B4     READ EVENT TIME
          SX3    X3-UETME
          SA1    RTCL        FETCH SECOND COUNTER
          MX0    -24
          LX1    24
          PL     X3,HNG      IF INVALID SUBFUNCTION
          BX1    -X0*X1
          IX3    X1-X2
          NG     X3,EAT5     IF EVENT TIME NOT ELAPSED
          SX5    X5
          IX6    X1+X5       TIME INTERVAL FOR EVENT
          SA6    A2
          BX7    X7-X7
          EQ     PPR1        SET REQUEST COMPLETE
 
 EAT5     SX7    B1          INDICATE TIME NOT ELAPSED
          LX7    36
          EQ     PPR1        REJECT REQUEST
 
 
 TSVT     BSSZ   UETME-UETMS  SYSTEM EVENT TIMES
 ECSM     SPACE  4
***       ECSM - ECS TRANSFER.
*         1.)    TRANSFER FROM 1 TO 100B WORDS TO/FROM RELATIVE ECS
*                USING A USER SPECIFIED CM BUFFER.
*         2.)    TRANSFER FROM 1 TO 100B WORDS TO/FROM ECS
*                USING A USER SPECIFIED CM BUFFER.
*         3.)    TRANSFER ECS ACCORDING TO A LIST OF ADDRESSES.
*         4.)    PERFORM FLAG REGISTER OPERATIONS.
 
 
***       RRES-WRES - READ/WRITE RELATIVE USER ECS.
*
*         ENTRY
*T, OR    12/  ECSM,6/  WC,18/  CMA,3/  SF,21/  ECA
*         WC     WORD COUNT - 1.
*         CMA    RELATIVE+400000B OR ABSOLUTE CM ADDRESS OF BUFFER.
*         SF     *RRES* OR *WRES* SUBFUNCTION CODE.
*         ECA    RELATIVE USER ECS ADDRESS.
*
*         EXIT
*T, OR    12/  0,12/  ST,12/,24/  ECD
*         ST     0 FOR TRANSFER COMPLETE.
*                1 FOR ADDRESS BEYOND RELATIVE FLX.
*                7777 FOR TRANSFER ABORTED.
*         ECD    ABSOLUTE USER ECS ADDRESS WHERE ERROR OCCURRED
*                IF ABORTED.
 
 
***       RECS-WECS - READ/WRITE ABSOLUTE SYSTEM ECS.
*
*         ENTRY
*T, OR    12/  ECSM,6/  WC,18/  CMA,3/  SF,21/  ECA
*         WC     NUMBER OF WORDS TO TRANSFER - 1.
*                WC = 0 TRANSFER 1 WORD.
*                WC = 1 TRANSFER 2 WORDS.
*                .
*                .
*                WC = 77B TRANSFER 100B WORDS.
*         CMA    RELATIVE+400000B OR ABSOLUTE CM ADDRESS OF BUFFER.
*         SF     *RECS* OR *WECS* SUBFUNCTION CODE.
*         ECA    ABSOLUTE SYSTEM ECS ADDRESS OF TRANSFER.
*
*         EXIT
*T, OR    12/  0,12/  ST,12/,24/  ECD
*         ST     0 FOR TRANSFER COMPLETE.
*                7777 FOR TRANSFER ABORTED.
*         ECD    ABSOLUTE SYSTEM ECS ADDRESS WHERE ERROR OCCURRED
*                IF ABORTED.
 
 
***       SFRS-CFRS - SET/CLEAR FLAG REGISTER BITS.
*         SFRM IS THE TEST AND SET FLAG REGISTER FUNCTION.
*         CFRM IS THE UNCONDITIONAL CLEAR FLAG REGISTER FUNCTION.
*
*         ENTRY
*T, OR    12/  ECSM,6/  ECB,18/,3/  SF,21/
*         ECB    ECS FLAG REGISTER BIT NUMBER TO SET/CLEAR.
*         SF     *SFRS* OR *CFRS* SUBFUNCTION CODE.
*
*         EXIT
*T, OR    12/  0,12/  ST,12/,12/,12/
*         ST     0 IF FUNCTION COMPLETED.
*         ST     7777 IF *SFRS* FUNCTION PERFORMED ON A BIT WHICH WAS
*                ALREADY SET.
 
 
***       PELS - PROCESS ECS ACCORDING TO LIST.
*
*         ENTRY
*T, OR    12/  ECSM,6/  WC,18/  CML,3/ SF,1/W,1/U,19/
*         WC     NUMBER OF LIST ENTRIES TO PROCESS.
*         CML    ABSOLUTE CM FWA OF LIST.
*         SF     *PELS* SUBFUNCTION CODE.
*         W      SET IF LIST OF ECS WORDS TO BE WRITTEN.
*                CLEAR IF LIST OF ECS WORDS TO BE READ.
*         U      SET IF LIST CONTAINS ABSOLUTE USER ECS ADDRESSES.
*                CLEAR IF LIST CONTAINS ABSOLUTE SYSTEM ECS ADDRESSES.
*
*T,CML    12/0,6/  CT,18/0,24/  ECS
*         CT     WORD COUNT TO TRANSFER (MAXIMUM OF 60D).
*         ECS    ABSOLUTE SYSTEM OR USER ECS ADDRESS.
*
*         THE LIST OF ECS DATA WORDS IMMEDIATELY FOLLOW THE
*         LIST OF ECS ADDRESSES.  DATA IS WRITTEN FROM THIS
*         BUFFER OR READ TO THIS BUFFER.
*
*         EXIT
*T, OR    12/  0,12/  ST,36/  0
*         ST     0 FOR TRANSFER COMPLETE.
*                7777 FOR TRANSFER ABORTED.
*
*T, CML   60/  EF
*         EF     ERROR FLAGS INDICATING ECS WORDS ON WHICH
*                ERROR OCCURRED IF TRANSFER ABORTED.
*                BIT 0 SET = ERROR OCCURRED ON ECS WORD
*                AT *ECS* + 0.
*                ...
*                BIT *CT* - 1 SET = ERROR OCCURRED ON ECS WORD
*                AT *ECS* + *CT* - 1.
 
 
          PPR    ECSM,(/LSPMMF/ECS,LSPMMF,/ECS/ECS)
 ECXM     SPACE  4,26
***       ECXM - TRANSFER EM DATA FOR ROLLIN/ROLLOUT.
*
*         THIS FUNCTION IS ISSUED BY *MTR* WHEN IT DETECTS AN *RCXM*
*         FUNCTION.  *1RI* AND *1RO* ISSUE THE *RCXM* FUNCTION DURING
*         ROLLIN/ROLLOUT OF EM.  TO ACHIEVE OPTIMAL PERFORMANCE, THE
*         PP POSTS THE REQUEST IN ITS OUTPUT REGISTER WITHOUT
*         EXCHANGING THE CPU.  *MTR* DETECTS THE REQUEST, CHANGES IT TO
*         AN *ECXM* FUNCTION AND PASSES IT TO *CPUMTR* AS A PROGRAM
*         MODE REQUEST.
*
*         ENTRY
*T, OR    12/  ECXM,29/ ,1/T,18/  ADDR
*         T      FUNCTION TYPE -
*                0   READ REQUEST.
*                1   WRITE REQUEST.
*         ADDR   RESPONSE ADDRESS.
*
*T, MB    12/  WC,12/,12/  CMA,24/  ECA
*         WC     WORD COUNT.
*         CMA    RELATIVE CM ADDRESS / 100B FOR START OF TRANSFER.
*         ECA    RELATIVE EM ADDRESS / 1000B FOR START OF TRANSFER.
*
*         EXIT
*T, OR    60/0
*T, ADDR  60/0   TRANSFER COMPLETED WITHOUT ERROR.
*T, ADDR  12/0,12/7777,36/0   ERROR(S) IN TRANSFER.
 
 
          PPR    ECXM,,(/PROGRAM/TEC,/PROGRAM/HNG,UEC)
 HNGM     SPACE  4,10
***       HNGM - HANG PP.
*
*         ENTRY
*T, OR    12/  HNGM,48/
*
*         EXIT
*T, OR    12/  HNGM,48/
 
 
          PPR    HNGM,.CHGM
 JACM     SPACE  4,25
***       JACM - JOB ADVANCEMENT CONTROL.
*
*         ENTRY
*T, OR    12/  JACM,12/ FLAGS,36/
*
*         FLAGS  *JACM* SUBFUNCTION FLAGS (SEE *COMSCPS*).
*
*         EXIT
*T, OR    60/  0
*
*         ON EXIT THE JOB ADVANCE AND JOB INTERLOCK FLAGS WILL BE
*         CLEARED UNLESS THE *CCPS* OPTION WAS SELECTED AND A *PEET*
*         ERROR IS PRESENT AT THE CONTROL POINT.  IN THAT CASE, THE
*         EJT INTERLOCK FLAGS WILL BE LEFT SET, THE CONTROL POINT
*         AREA FIELDS WILL NOT BE CLEARED, THE EJT ENTRY WILL NOT BE
*         RELEASED, AND THE *FZSI* SUBSYSTEM ID WILL BE SET.
*
*         THE FOLLOWING CONDITIONS WILL HANG THE PP -
*                UNDEFINED OPTION SPECIFIED.
*                SPECIFIED OPTION COMBINATION NOT VALID.
*                NO JOB PRESENT AT CONTROL POINT.
*                JOB ADVANCE FLAG OR JOB INTERLOCK FLAG CLEAR ON ENTRY.
 
 
          PPR    JACM
 
          SA3    B7+TFSW     GET EJT ORDINAL
          SX7    753200B     SET VALID OPTIONS MASK
          AX1    36
          MX0    -12
          SB3    X1+59-17    SPECIFIED OPTIONS
          SX1    X1-20B
          PL     X1,HNG      IF UNDEFINED OPTION SPECIFIED
          LX7    B3
          LX3    12
          PL     X7,HNG      IF SPECIFIED OPTIONS NOT VALID
          BX4    -X0*X3      EJT ORDINAL
          CX3    X4,EJT      CONVERT EJT ORDINAL TO OFFSET
          ZR     X4,HNG      IF NO JOB PRESENT
          TA3    X3+JSNE,EJT
          SX7    101B
          BX6    X3-X7       TOGGLE JOB INTERLOCK AND JOB ADVANCE
          BX3    X7*X6
          LX5    59-36
          NZ     X3,HNG      IF JOB ADVANCE OR INTERLOCK CLEAR ON ENTRY
          SA6    A3          UPDATE *JSNE*
          NG     X5,JAC3     IF RELEASE CP OPTION SPECIFIED
 
*         PROCESS NORMAL JOB ADVANCE OR ROLLIN.  THE CPU PRIORITY WILL
*         BE SET TO THE NEW SERVICE CLASS PRIORITY IF THE SERVICE CLASS
*         PRIORITY CHANGED WHILE THE JOB WAS ADVANCING OR ROLLED OUT.
 
          SA2    B7+CWQW
          MX7    -9
          UX6,B5 X2          UNPACK CPU PRIORITY AND PARAMETERS
          LX2    -27
          SX3    B5
          BX2    -X7*X2      SERVICE PARAMETERS INDEX
          AX3    3           REMOVE FLAGS FROM CPU PRIORITY
          TA2    X2+CSJT,JCB
          AX2    48          SERVICE CLASS CPU PRIORITY
          IX7    X2-X3
          ZR     X7,JAC1     IF JOB AT SERVICE CLASS PRIORITY
          BX7    X6
          LX7    59-45
          NG     X7,JAC1     IF PRIORITY NOT SET FROM SERVICE CLASS
          LX2    3
          SX7    B1
          SB5    X2
          LX7    47-0
          PX6    B5,X6       SET NEW PRIORITY
          BX6    X6+X7       SET INCOMPLETE EXTENDED CPU SLICE
          SA6    B7+CWQW     UPDATE CPU PRIORITY AND FLAGS
          SX6    B0+
          SA6    B7+CSAW     CLEAR SERVICE CYCLE AND ACCUMULATORS
 JAC1     LX5    59-39-59+36
          SB6    B7          SET EXCHANGE PACKAGE ADDRESS
          SB3    JAC2        SET *RCC* EXIT ADDRESS
          NG     X5,RCC      IF REQUEST CPU OPTION
 JAC2     LX5    59-37-59+39
          NG     X5,.DPPM    IF TO DROP PP
          SX7    B0
          EQ     PPR1        EXIT TO CLEAR OUTPUT REGISTER
 
*         CHECK FOR CM/CPU PARITY ERROR AT CONTROL POINT TO BE
*         RELEASED.
 
 JAC3     SA1    B7+STSW
          SX6    10001B      SET *STSW* = 1 PP, SET RECALL STACK INDEX
          SX7    B0
          LX6    -12
          LX1    -36
          SA6    A1          UPDATE *STSW*
          BX1    -X0*X1      ERROR FLAG
          SB4    X1-PEET     SET *PEET* ERROR INDICATOR
          SX6    B0
          NZ     B4,JAC4     IF NO *PEET* ERROR SET
          SA2    A1          RESET *PEET* ERROR FLAG
          LX1    36
          BX6    X2+X1
          SA6    A1
          SX6    100B
          SA3    A3          GET *JSNE*
          BX6    X3+X6       RESET JOB ADVANCE FLAG
          SA6    A3          UPDATE *JSNE*
          BX6    X4          SET TO PRESERVE EJT ORDINAL
          SX7    FZSI        SET *FZSI* ID
          LX6    48
          LX7    24
 
*         CLEAR CONTROL POINT AREA WORDS.
 
 JAC4     SA6    B7+TFSW     CLEAR (IF NO *PEET* ERROR) EJT ORDINAL
          SA7    B7+JCIW     CLEAR (SET IF *PEET* ERROR) JOB CONTROL
          BX7    X7-X7
          BX6    -X6+X6
          SA7    B7+CSSW     CLEAR PROCEDURE FILE DISK ADDRESS
          SA7    B7+RFCW     CLEAR RESOURCE CONTROL
          SA7    B7+EOJW     CLEAR END OF JOB PROCESSING FLAGS
          SA7    B7+SRUW     CLEAR LIMIT FLAGS
          ZR     B4,JAC5     IF *PEET* ERROR
          SA6    B7+PFCW     SET FAMILY TO NULL
          SA7    B7+MS1W     CLEAR MESSAGES
 JAC5     SA7    B7+MS2W
          SA7    B7+SSCW     CLEAR SCP CONNECTIONS
 
*         RESET RECALL AREA LINKS.
 
          SX7    B1
          SX1    B1
          SB5    B7+RCCW-2
 JAC6     SX7    X7+B1
          SX6    X7-LREC
          SA7    B5+X7
          NZ     X6,JAC6     IF NOT FINISHED
 
*         CLEAR RECALL STACK.
 
          SB5    B5+RECW-RCCW+2
 JAC7     IX7    X7-X1
          SA6    B5+X7
          PL     X7,JAC7     IF NOT FINISHED
          LX5    59-38-59+36
          PL     X5,JAC9     IF NOT CLEARING EJT ENTRY
          ZR     B4,JAC9     IF *PEET* ERROR
          SX1    PEJT        SET EJT PROCESSING
          LX4    36          SET EJT ORDINAL
          LX1    24
          BX1    X1+X4
          SB6    JAC8        SET *MTRM* RETURN ADDRESS
          EQ     MTM0        RETURN EJT ENTRY TO POOL
 
 JAC8     SA5    A5+         RESTORE OUTPUT REGISTER
          LX5    59-38
 JAC9     LX5    59-37-59+38
          SX7    B0
          PL     X5,PPR1     IF NOT DROP PP OPTION
          EQ     .DPPM       DROP PP
 LDAM     SPACE  4,35
***       LDAM - LOAD ADDRESS FOR MASS STORAGE DRIVERS.
*
*         ENTRY
*
*T, OR    12/  LDAM,12/  RW,36/
*T, MB    12/,12/  EQ,12/  LT,12/  LS,12/
*
*         RW     READ/WRITE FLAG, VALID ONLY FOR ISD DEVICES.
*                0, IF TO ISSUE SEEK ONLY.
*                *RDS2*, IF TO ISSUE READ/SEEK.
*                *WDS2*, IF TO ISSUE WRITE/SEEK.
*         EQ     EQUIPMENT.
*         LT     LOGICAL TRACK.
*         LS     LOGICAL SECTOR.
*
*         EXIT
*
*T, OR    12/  0,12/  0,12/  0,12/  F,12/  RS
*T, MB    60/  UNCHANGED
*T, MB+1  12/  LU,6/  RW,6/  PU,12/  PC,12/  PT,12/  PS
*T, MB+2  60/  0
*
*         F      STATUS FLAGS.
*                4 = UNIT SWITCH NEEDED.
*                11 = REQUEST CHANNEL IF NOT RESERVED.
*                7777 - ADDE = ADDRESS ERROR.
*                7777 - NRDE = REDEFINITION REQUESTED.
*         RS     REMAINING SECTORS TILL *LDAM* REQUIRED.
*         LU     LOGICAL UNIT.
*         RW     READ/WRITE FLAG.
*                0, IF TO ISSUE SEEK ONLY (NON-ISD DEVICES).
*                1, IF TO ISSUE WRITE/SEEK.
*                2, IF TO ISSUE READ/SEEK.
*         PU     PHYSICAL UNIT.
*         PC     PHYSICAL CYLINDER.
*         PT     PHYSICAL TRACK.
*         PS     PHYSICAL SECTOR.
*
*
*         HANG CONDITIONS -
*
*         ILLEGAL ALGORITHM INDEX.
*         ALGORITHM INDEX FOUND IN THE MST FOR THE EQUIPMENT IS OUT
*         OF RANGE (.GE. AIMX) OR NO PROCESSOR IS DEFINED FOR THE
*         ALGORITHM INDEX.
 
 
          PPR    LDAM,,,FEX
 
          SA3    A5+B1       GET PARAMETER WORD
          MX2    -12
          LX3    -12
          BX5    -X2*X3      LS
          LX3    -24
          BX0    -X2*X3      EST ORDINAL
          LX3    12
          CX1    X0,EST      CONVERT EST ORDINAL TO OFFSET
          TA1    X1+EQDE,EST READ EST ENTRY
          BX1    -X2*X1      MST/10B
          LX1    3
          SA1    X1+DILL     READ ALGORITHM INDEX
          MX0    -6
          BX2    -X0*X1      ALGORITHM INDEX
          SX4    X2-AIIE
          NG     X4,LDA1     IF NOT BUFFERED DEVICE
          SX4    X2-AIBD
          PL     X4,LDA1     IF NOT BUFFERED DEVICE
          SA4    A1+DALL-DILL
          SX1    3
          LX1    36
          BX6    X1+X4
          SA6    A4+
 LDA1     SA4    A1+DDLL-DILL  READ UNIT LIST
          SB3    X2-AIMX
          SA2    TALP+X2     READ PROCESSING PARAMETERS
          SB4    B0+
          PL     B3,HNG      IF ILLEGAL ALGORITM INDEX
          SB6    X2          SET PROCESSOR ADDRESS
          BX1    X4
          AX2    48
          AX1    48
          IX6    X5-X2
          SB3    B0          PRESET TO LOGICAL UNIT ZERO
          BX7    X7-X7
          NG     X6,LDA3     IF FIRST UNIT
          MX7    -3
          PX6    X2
          BX1    -X7*X1
          PX7    X5
          NX6    X6
          FX7    X7/X6       LU = LS / SL
          UX7,B3 X7
          LX7    B3
          IX6    X1-X7
          SB3    X7+
          IX1    X7*X2
          SB3    B3+X7
          PL     X6,LDA2     IF NO ADDRESS ERROR
          SB4    7777B-ADDE  SET ADDRESS ERROR
 LDA2     SB3    B3+X7
          SB3    B3+B3       LU * 6
          IX5    X5-X1       R(LS/SL)
          AX4    B3          POSITION PU
 LDA3     TX1    A5-1,-FP
          LX1    PPXES-PPCES
          BX0    -X0*X4      EXTRACT PHYSICAL UNIT NUMBER
          TA1    X1+DRQP,FPX GET CURRENT UNIT NUMBER
          AX1    48
          BX1    X1-X7
          NG     X1,LDA4     IF NULL ENTRY
          ZR     X1,LDA4     IF NO CHANGE IN UNIT
          NZ     B4,LDA4     IF ADDRESS ERROR
          SB4    4
 LDA4     LX7    12
          SB3    B1+B1
          BX6    X7+X0
          MX4    -11
          IX7    X2-X5       RS
          LX6    36
          SX1    B3+B1
          BX4    -X4*X3
          SX0    1
          JP     B6          EXIT TO PROCESSOR
 LAP      SPACE  4
**        LAP - LOAD ADDRESS PROCESSORS.
*
*                THE FUNCTION OF AN ADDRESS PROCESSOR IS TO CONVERT
*         LOGICAL DISK ADDRESSES TO THE CORRESPONDING PHYSICAL
*         ADDRESSES FOR A PARTICULAR EQUIPMENT TYPE.  EACH ADDRESS
*         PROCESSOR HAS THE FOLLOWING ENTRY AND EXIT CONDITIONS BUT
*         PRODUCES THE PARAMETERS *PC*, *PT* AND *PS* USING AN
*         ALGORITHM UNIQUE TO THE EQUIPMENT TYPE.
*
*         LT = LOGICAL TRACK.
*         LS = LOGICAL SECTOR.
*         R(A/B) = REMAINDER OF A/B.
*         PC = PHYSICAL CYLINDER.
*         PT = PHYSICAL TRACK.
*         PS = PHYSICAL SECTOR.
*         PU = PHYSICAL UNIT.
*         RS = REMAINING SECTOR COUNT UNTIL POSITION REQUIRED.
*         SL = SECTOR LIMIT.
*         SC = SECTORS FROM BEGINNING OF TRACK TO END OF CYLINDER.
*
*         ENTRY  (X0) = 1.
*                (X1) = 3.
*                (X2) = SL (SINGLE UNIT SECTOR LIMIT).
*                (X4) = LT - 4000B. (LOGICAL TRACK NUMBER)
*                (X5) = R(LS/SL)
*                (X6) = 12/,12/PU,36/0.
*                (X7) = RS (SL-R(LS/SL)) (SECTORS TO NEXT *LDAM*).
*                (A5) = OUTPUT REGISTER ADDRESS.
*                (B3) = 2.
*                (B4) = PRESET RETURN STATUS.
*
*         EXIT   (MB) = 12/,12/  PU,12/  PC,12/  PT,12/  PS
*                (OR) = 12/  0,12/  F,24/,12/  RS
*
*         USES   ADDRESS PROCESSORS MAY USE ALL REGISTERS EXCEPT -
*                A0, A5, B1, B2, B4, B7.
 
 
          SPACE  4,10
**        COMPLETE ADDRESS PROCESSING.
*
*         ENTRY  (X0) + (X5) = RELATIVE SECTOR NUMBER IN CYLINDER.
*                (X1) = SECTORS PER PHYSICAL TRACK.
*                (X3) = PHYSICAL CYLINDER IN BYTE 2.
*                (X6) = 12/,12/PU,36/0.
*                (X7) = REPLY FOR *OR*.
*                (B4) = RETURN STATUS.
 
 
 LDA6     IX0    X0+X5       (X0) = RELATIVE SECTOR IN CYLINDER
          PX4    X1
          PX2    X0
          NX4    X4
          FX2    X2/X4
          UX2,B3 X2
          LX2    B3          (X2) = PHYSICAL TRACK
          IX4    X2*X1
          IX4    X0-X4       (X4) = PS
 
*         ENTRY  (X1) = SECTORS PER PHYSICAL TRACK.
*                (X2) = PHYSICAL TRACK.
*                (X3) = PHYSICAL CYLINDER IN BYTE 2.
*                (X4) = PHYSICAL SECTOR.
*                (X6) = 12/,12/PU,36/0.
*                (X7) = SECTORS TO NEXT *LDAM*.
*                (B4) = RETURN STATUS.
 
 LDA7     LX2    12
          BX3    X3+X4
          BX6    X6+X2       MERGE PT IN REPLY
          BX6    X6+X3       MERGE PS AND CY IN REPLY
          SX1    B4+         RETURN STATUS
          SA6    A3+1        (MB+1) = PARAMETERS
          NZ     B4,LDA8     IF STATUS TO RETURN
          SX1    11B         REQUEST CHANNEL STATUS
 LDA8     BX6    X6-X6
          LX1    12
          BX7    X7+X1
          SA6    A6+B1       CLEAR (MB+2)
          SA7    A5          STORE (OR)
          EQ     PPRX        RETURN
 TBLM     SPACE  4,10
**        TBLM - GENERATE TABLE OF LDAM PARAMETERS.
 
 
          PURGMAC TBLM
 TBLM     MACRO  EQ
          IFNE   LDAM_EQ,0,1
          VFD    12/SL_EQ,30/0,18/LA_EQ
          ENDM
 TALP     SPACE  4
**        TALP - TABLE OF ALGORITHM PROCESSING PARAMETERS.
*
*         ONE WORD ENTRIES INDEXED BY ALGORITHM INDEX.
*
*T, TALP  12/  SL,30/,18/  AP
*
*                SL = SECTOR LIMIT.
*                AP = ALGORITHM PROCESSOR.
 
 
 TALP     VFD    24/,18/1,18/HNG
 
          LIST   G
          TBL    "MSEQ"
          LIST   *
          PURGMAC TBLM
 LADI     SPACE  4,20
**        LADI - 7X54/844-21 ADDRESS CONVERSION PROCESSOR.
*
*         ALGORITHM -
*         SL = 153B                    SECTOR LIMIT
*         HC = BIT 0 OF LT             HALF CYLINDER BIT
*         HT = BIT 1 OF LT             HALF TRACK BIT
*         LU = LS/SL                   LOGICAL UNIT
*         PC = BITS 2 - 10 OF LT       PHYSICAL CYLINDER
*         PT = (HT+2*R(LS/SL))/30B+HC*11B  PHYSICAL TRACK
*         PS = R((HT+2*R(LS/SL))/30B)  PHYSICAL SECTOR
*         RS = SL-R(LS/SL)             REMAINING SECTORS TO NEXT LDAM
*
*         EXIT   (X0) = HC*330B+HT
*                (X5) = 2*R(LS/SL)
 
 
 LADI     BX3    -X1*X4      PC
          LX4    -1
          LX3    24-2
          BX0    X0*X4       HT
          PL     X4,LAI1     IF IN FIRST HALF OF CYLINDER
          SX0    X0+330B
 LAI1     LX5    1
          LX1    3           30B SECTORS PER PHYSICAL TRACK
          EQ     LDA6        COMPLETE ADDRESS CONVERSION
 LADJ     SPACE  4,20
**        LADJ - 7X54/844-4X ADDRESS CONVERSION PROCESSOR.
*
*         ALGORITHM -
*         SL = 343B                    SECTOR LIMIT
*         HT = BIT 0 OF LT             HALF TRACK BIT
*         LU = LS/SL                   LOGICAL UNIT
*         PT = (HT+2*R(LS/SL))/30B     PHYSICAL TRACK
*         PC = BITS 1 - 10 OF LT       PHYSICAL CYLINDER
*         PS = R((HT+2*R(LS/SL))/30B)  PHYSICAL SECTOR
*         RS = SL-R(LS/SL)             REMAINING SECTORS TO NEXT LDAM
*
*         EXIT   (X0) = HT
*                (X5) = 2*R(LS/SL)
 
 
 LADJ     BX3    -X0*X4      PC
          LX5    1           2*R(LS/SL)
          BX0    X0*X4       HT
          LX3    24-1
 LAJ1     LX1    3           30B SECTORS PER PHYSICAL TRACK
          EQ     LDA6        COMPLETE ADDRESS CONVERSION
 LDAK     SPACE  4,20
**        LADK - 7154/844-21 ADDRESS CONVERSION PROCESSOR.
*
*         ALGORITHM -
*         SL = 160B                    SECTOR LIMIT
*         LU = LS/SL                   LOGICAL UNIT
*         PC = BITS 2 - 10 OF LT       PHYSICAL CYLINDER
*         XX = BITS 0 AND 1 OF LT      TRACK NUMBER WITHIN CYLINDER
*         PT = (XX*162B+R(LS/SL))/30B  PHYSICAL TRACK
*         PS = R((XX*162B+R(LS/SL))/30B)  PHYSICAL SECTOR
*         RS = SL-R(LS/SL)             REMAINING SECTORS TO NEXT LDAM
*
*         EXIT   (X0) = XX*162B
*                (X5) = R(LS/SL)
 
 
 LADK     BX3    -X1*X4      (X3) = PC * 4
          SX2    X2+B3       (X2) = 162B
          BX0    X1*X4       XX
          LX3    24-2
          IX0    X0*X2       XX * 162B
          LX1    3           30B SECTORS PER PHYSICAL TRACK
          EQ     LDA6        COMPLETE CONVERSION
 LADL     SPACE  4,15
**        LADL - 7154/844-4X ADDRESS CONVERSION PROCESSOR.
*
*         ALGORITHM -
*         SL = 343B                    SECTOR LIMIT
*         LU = LS/SL                   LOGICAL UNIT
*         PC = BITS 1 - 10 OF LT       PHYSICAL CYLINDER
*         X = BIT 0 OF LT              TRACK NUMBER WITHIN CYLINDER
*         PT = (X*345B+R(LS/SL))/30B   PHYSICAL TRACK
*         PS = R((X*345B+R(LS/SL))/30B)  PHYSICAL SECTOR
*         RS = SL-R(LS/SL)             R*
*         EXIT   (X0) = X*345B
*                (X5) = R(LS/SL)
 
 
 LADL     BX3    -X0*X4      (X3) = PC * 2
          LX4    -1
          LX3    24-1
          AX4    59
          SX0    X2+B3       (X0) = 345B
          BX0    X4*X0
          EQ     LAJ1        COMPLETE ADDRESS CONVERSION
 LADM     SPACE  4,10
**        LADM - 7155/885 HALF TRACK ADDRESS CONVERSION.
*
*         ALGORITHM -
*         SL = 1200B                    SECTOR LIMIT
*         HT = BIT 0 OF LT              HALF TRACK BIT
*         LU = LS/SL                    LOGICAL UNIT
*         PC = BITS 1 - 10 OF LT        PHYSICAL CYLINDER
*         PT = (HT+2*R(LS/SL))/40B      PHYSICAL TRACK
*         PS = R((HT+2*R(LS/SL))/40B)   PHYSICAL SECTOR
*         RS = SL-R(LS/SL)              REMAINING SECTORS TILL LDAM
*
*         EXIT
 
 
 LADM     BX3    -X0*X4      PC
          LX5    1
          BX0    X0*X4       HT
          LX3    24-1
 LAM1     IX2    X0+X5       RELATIVE SECTOR IN CYLINDER
          MX1    -5
          BX4    -X1*X2      PS
          AX2    5           PT
          EQ     LDA7        COMPLETE PROCESSING
 LADQ     SPACE  4,10
**        LADQ - 7155/885 FULL TRACK ADDRESS CONVERSION.
*
*         ALGORITHM -
*         SL = 1200B                    SECTOR LIMIT
*         X  = BIT 0 OF LT              LOGICAL TRACK IN CYLINDER
*         LU = LS/SL                    LOGICAL UNIT
*         PC = BITS 1 - 10 OF LT        PHYSICAL CYLINDER
*         PT = (X*SL+R(LS/SL))/40B      PHYSICAL TRACK
*         PS = R((X*SL+R(LS/SL))/40B)   PHYSICAL SECTOR
*         RS = SL-R(LS/SL)              REMAINING SECTORS TILL LDAM
*
*         EXIT
 
 
 LADQ     LX4    -1
          SX3    X4          PC
          AX4    59
          LX3    24
          BX0    X4*X2
          EQ     LAM1        COMPLETE CONVERSION
 LADR     SPACE  4,10
**        LADR - CDSS II ADDRESS CONVERSION.
*
*         ALGORITHM -
*         SL = 3600B                    SECTOR LIMIT
*         X  = BIT 0 OF LT              LOGICAL TRACK IN CYLINDER TRIAD
*         SO = 1200B*X                  STARTING SECTOR OFFSET
*         PC = LT+(LT/2)+(LS+SO)/2400B  PHYSICAL CYLINDER
*         SC = R((LS+SO)/2400B)         SECTOR WITHIN CYLINDER
*         PT = SC/40B                   PHYSICAL TRACK
*         PS = SC-PT*40B                PHYSICAL SECTOR
*         RS = MAGIC                    SECTORS UNTIL NEXT LDAM
*         EXIT
 
 LADR     AX3    X4,B1       CYLINDER TRIAD (LT/2)
          MX2    -1
          IX3    X4+X3       PC (WHERE TRACK STARTS) (LT+(LT/2))
          BX2    -X2*X4      TRIAD HALF (X)
          SB3    X2
          SX2    2400B       SET *LDAM* LIMIT AT END-OF-CYLINDER
          AX4    X2,B3       2400B, 1200B FOR X = 0, 1. EOC SECTOR.
          IX0    X2-X4          0B, 1200B FOR X = 0, 1. SECTOR OFFSET
          IX2    X5-X4       LOGICAL SECTOR - END OF CYLINDER
          NG     X2,LAR1     IF SECTOR IS ON FIRST CYLINDER
          SX4    1200B       SET *LDAM* LIMIT AT END-OF-TRACK
          LX4    B3          1200B, 2400B FOR X = 0, 1.
          BX5    X2          SECTOR WITHIN SECOND CYLINDER
          SX3    X3+1        PC (WHERE TRACK ENDS)
          SX0    B0+         CLEAR STARTING SECTOR OFFSET
 LAR1     IX7    X4-X5       RS
          LX3    24          PC
          EQ     LAM1        COMPLETE CONVERSION
 LADX     SPACE  4,10
**        LADX - 3330-1 FULL TRACK CONVERSION.
*
*         ALGORITHM -
*         SL = 142B                    SECTOR LIMIT
*         LU = LS/SL                   LOGICAL UNIT
*         PC = BITS 2 - 10 OF LT       PHYSICAL CYLINDER
*         XX = BITS 0 - 1 OF LT        TRACK NUMBER WITHIN CYLINDER
*         PT = (XX*144B+R(LS/SL))/25B  PHYSICAL TRACK
*         PS = R((XX*144B+R(LS/SL))/25B)  PHYSICAL SECTOR
*         RS = SL-R(LS/SL)             REMAINING SECTORS TO NEXT LDAM
 
 
 LADX     BX3    -X1*X4      (X3) = PC * 4
          SX2    X2+B3       (X2) = 144B
          BX0    X1*X4       XX
          IX0    X0*X2       XX * 144B
 LAX1     SX1    25B         (X1) = SECTORS PER PHYSICAL TRACK
          LX3    24-2
          EQ     LDA6        COMPLETE ADDRESS CONVERSION
 LADY     SPACE  4,10
**        LADY - 3330-11 FULL TRACK CONVERSION.
*
*         ALGORITHM -
*         SL = 306B                    SECTOR LIMIT
*         LU = LS/SL                   LOGICAL UNIT
*         PC = BITS 1 - 10 OF LT       PHYSICAL CYLINDER
*         X  = BIT 0 OF LT             TRACK NUMBER WITHIN CYLINDER
*         PT = (X*310B+R(LS/SL))/25B   PHYSICAL TRACK
*         PS = R((X*310B+R(LS/SL))/25B)  PHYSICAL SECTOR
*         RS = SL-R(LS/SL)             REMAINING SECTORS TO NEXT LDAM
 
 
 LADY     BX3    -X0*X4      (X3) = PC * 2
          LX4    -1
          LX3    1
          AX4    59
          SX0    X2+B3       (X0) = 310B
          BX0    X4*X0
          EQ     LAX1        COMPLETE PROCESSING
 LADZ     SPACE  4,10
**        LADZ - 3350 FULL TRACK CONVERSION.
*
*         ALGORITHM -
*         SL = 644B                    SECTOR LIMIT
*         LU = LS/SL                   LOGICAL UNIT
*         PC = BITS 1 - 10 OF LT       PHYSICAL CYLINDER
*         X  = BIT 0 OF LT             TRACK NUMBER WITHIN CYLINDER
*         PT = (X*SL+R(LS/SL))/34B     PHYSICAL TRACK
*         PS = R((X*SL+R(LS/SL))/34B)  PHYSICAL SECTOR
*         RS = SL-R(LS/SL)             REMAINING SECTOR TILL LDAM
 
 
 LADZ     BX3    -X0*X4      (X3) = PC * 2
          LX4    -1
          SX0    X2          SL
          AX4    59
          LX3    24-1
          BX0    X4*X0
          EQ     LA12        COMPLETE ADDRESS CONVERSION
 LAD1     SPACE  4,10
**        LADA - 33502 FULL TRACK CONVERSION.
*
*         ALGORITHUM -
*         SL = 1510                    SECTOR LIMIT
*         VL = TL/2                    VOLUME TRACK LIMIT
*         LU = LS/SL                   LOGICAL UNIT
*         PC = LT-(VL*(LT/VL))         PHYSICAL CYLINDER
*         X = 0                        LOGICAL TRACK WITHIN CYLINDER
*         PT = X*SL+R(LS/SL))/34B      PHYSICAL TRACK
*         PS = R((X*SL+R(LS/SL))/34B)  PHYSICAL SECTOR
*         PU = (LT/VL)*40B+UNIT        PHYSICAL UNIT
 
 
 LADA     BX3    X4          LT
          SX0    NTDA/2      SET TRACK LIMIT PER VOLUME
          IX1    X4-X0       LT MINUS TRACK LIMIT PER VOLUME
          SX0    40B
          SB3    B0          CLEAR VOLUME FLAG
          SA2    A1          GET LAST VOLUME USED FLAG
          NG     X1,LA11     IF ON VOLUME 0
          BX3    X1          SET CYLINDER FOR VOLUME 1
          MX0    0
          SB3    B1+         INDICATE VOLUME ONE
 LA11     LX0    36
          LX2    18
          BX1    X6-X0       SWITCH TO CORRECT VOLUME
          SB6    X2
          SB6    B6-B3
          ZR     B6,LA11.1   IF NOT SWITCHING VOLUMES
          SX6    B3
          AX2    18
          LX6    -18
          NZ     B4,LA11.1   IF PREVIOUS ERROR
          SB4    4           SET UNIT SWITCH FOR *DSWM*
          BX6    X2+X6
          SA6    A2
 LA11.1   BX6    X1
          LX3    24          POSITION PC
          SX0    B0
 LA12     SX1    34B         SECTORS PER PHYSICAL TRACK
          EQ     LDA6        COMPLETE ADDRESS PROCESSING
 LADB     SPACE  4,15
**        LADB - 885-42 PARALLEL HEAD DEMA.
*
*         ALGORITHM -
*         SL = 1200B                   SECTOR LIMIT
*         X  = BIT 0 OF LT             LOGICAL TRACK IN CYLINDER
*         LU = LS/SL                   LOGICAL UNIT
*         PC = 1 - 11 OF LT       PHYSICAL CYLINDER
*         PT = (X*SL+R(LS/SL))/200B    PHYSICAL TRACK
*         PS = (R(X*SL+R(LS/SL))/200B)/4 PHYSICAL SECTOR
 
 
 LADB     BSS    0
          LX4    -1
          SX3    X4          PC
          AX4    59
          LX3    24          PC IN BYTE 2
          BX0    X4*X2
          IX2    X0+X5       RELATIVE SECTOR IN CYLINDER
          MX1    -7
          BX4    -X1*X2
 
*         ADD CODE HERE TO PULL OFF LOWER 2 BITS OF X4 AS
*         RELATIVE LOGICAL PRU IN LARGE SECTOR.
 
          AX4    2           PS
          AX2    7           PT
          EQ     LDA7        COMPLETE PROCESSING
LADC      SPACE  4,10
**        LADC - 7165/895 FULL TRACK CONVERSION (*DC*).
*
*         THIS ALGORITHM RETURNS A SMALL RECORD ADDRESS AND AS SUCH,
*         IT CAN NOT BE USED TO READ LARGE RECORDS.
*
*         ALGORITHM -
*         SL = 1300B                            SECTOR LIMIT
*         LU = LS/SL                            LOGICAL UNIT
*         X  = BIT 0 OF LT
*         PC = BITS 1 - 10 OF LT                PHYSICAL CYLINDER
*         PT = (X*SL + R(LS/SL))/140B           PHYSICAL TRACK
*         PS = R((X*SL + R(LS/SL))/140B)        PHYSICAL SECTOR
 
 
 LADC     LX4    -1
          SX3    X4          PC
          AX4    59          X
          LX3    24          POSTION PC IN BYTE 2
          BX4    X4*X2       X*SL
          SX1    140B
          IX5    X4+X5       X*SL + R(LS/SL)
          PX0    X1
          PX4    X5
          NX0    X0
          FX4    X4/X0       (X*SL + R(LS/SL))/140B
          UX4,B3 X4
          LX2    X4,B3       PT
          IX4    X2*X1       (X*SL + R(LS/SL))/140B*140B
          IX4    X5-X4       R((X*SL + R(LS/SL))/140B)
          EQ     LDA7        RETURN PHYSICAL DISK ADDRESS
 LADD     SPACE  4,10
**        LADD   - 7255/834 FULL TRACK ADDRESS CONVERSION.
*
*         ALGORITHM -
*         SL = 240B                       SECTOR LIMIT
*         X = BIT 0 OF LT                 LOGICAL TRACK IN CYLINDER
*         LU = LS/SL                      LOGICAL UNIT
*         PC = BITS 1 - 10 OF LT          PHYSICAL CYLINDER
*         PT = (X*SL+R(LS/SL))/40B        PHYSICAL TRACK
*         PS = R((X*SL+R(LS/SL))/40B)     PHYSICAL SECTOR
*         RS = SL-R(LS/SL)                REMAINING SECTORS TILL LDAM
 
 
 LADD     SX1    40B         SECTORS PER PHYSICAL TRACK
 LAD1     LX4    -1
          SX3    X4          PHYSICAL CYLINDER
          AX4    59
          LX3    24
          BX0    X4*X2       X*SL
          SA2    A5
          LX2    12
          AX2    48
          ZR     X2,LDA6     IF TO ISSUE A SEEK ONLY
          SX4    X2-.RDS2    CHECK FOR *RDS2*
          SX2    B1+B1
          ZR     X4,LAD2     IF TO ISSUE A READ/SEEK
          SX2    B1          ISSUE A WRITE/SEEK
 LAD2     LX2    42
          BX6    X2+X6
          EQ     LDA6        COMPLETE ADDRESS PROCESSING
 LADG     SPACE  4,10
**        LADG   - 7255/836 FULL TRACK ADDRESS CONVERSION.
*
*         ALGORITHM -
*         SL = 1064B                      SECTOR LIMIT
*         X = BIT 0 OF LT                 LOGICAL TRACK IN CYLINDER
*         LU = LS/SL                      LOGICAL UNIT
*         PC = BITS 1 - 10 OF LT          PHYSICAL CYLINDER
*         PT = (X*SL+R(LS/SL))/57B        PHYSICAL TRACK
*         PS = R((X*SL+R(LS/SL))/57B)     PHYSICAL SECTOR
*         RS = SL-R(LS/SL)                REMAINING SECTORS TILL LDAM
 
 
 LADG     SX1    57B         SECTORS PER PHYSICAL TRACK
          EQ     LAD1        COMPLETE ADDRESS PROCESSING
 LMSM     SPACE  4,20
***       LMSM - LOAD MASS STORAGE DRIVERS.
*
*         ENTRY
*
*T, OR    12/  LMSM,2/ ,1/C,9/  EQ,12/,6/    ,18/    SMSOP
*T, MB    12/      ,12/  WDSE,12/,12/      ,12/
*T, MB+1  12/      ,12/      ,12/,7/,5/ MSD,12/  CHRV
*
*         C      *6DC* REQUEST (ONLY IF CPP).
*         EQ     EQUIPMENT.
*         SMSOP  3/  WP,12/  UERR,3/  SF
*         WP     4 = WDSE ADDRESS VALID IN CALL.
*                0 = NO VALID WDSE ADDRESS IN CALL.
*         UERR   CALLERS ERROR PROCESSING OPTIONS.
*         SF     SUBFUNCTION CODE.                       *SETMS* OPTION
*                0 = NORMAL I/O.                              *IO*
*                1 = PROTECTED SECTOR I/O.                    *PIO*
*                2 = PROTECTED SECTOR I/O, SELECTED CHANNEL.  *PIOCH*
*                3 = READ SYSTEM FILE.                        *READSYS*
*                4 = READ STREAM.                             *READSTR*
*                5 = RETURN DEVICE STATUS.                    *STATUS*
*                6 = NORMAL I/O ON SELECTED CHANNEL.          *IOCH*
*         WDSE   WRITE ERROR PROCESSING BUFFER ADDRESS.
*         MSD    MASS STORAGE DRIVER INDEX.
*         CHRV   CHANNEL RESERVATION STATUS.
*
*         EXIT
*
*T, OR    12/  0,6/     0,18/  DRA,12/   DRL,12/  2
*T, MB    12/ DP,12/ WDSE,12/    0,12/  RDCT,12/  STSA
*T, MB+1  12/  S,12/ UERR,12/  SLM,12/   MSD,12/  CHRV
*T, MB+2  60/  EST
*
*         DRA    LOAD ADDRESS OF DRIVER.  ZERO IF NO DRIVER LOAD.
*         DRL    LENGTH OF DRIVER IN CM WORDS.
*         DP     DEVICE PARAMETER FROM BYTE 2 OF EST WORD *EQAE*.
*         WDSE   WRITE ERROR PROCESSING BUFFER, ZERO IF NO VALID
*                ADDRESS PASSED ON CALL.
*         RDCT   0
*         STSA   2, IF DRIVER PRESET NOT TO BE EXECUTED.
*         S      2000 IF FULL TRACK DEVICE.
*                2001 IF HALF TRACK DEVICE.
*         UERR   CALLERS ERROR PROCESSING OPTIONS.
*                WHEN THE *READSYS* OPERATION TYPE IS SPECIFIED, THE
*                *NS* ERROR PROCESSING OPTION IS IMPLIED.  ALTHOUGH
*                THE *EPNS* BIT IS NOT FORCED SET BY *READSYS*, *MTR*
*                WILL NOT RETURN THE *LNRE* ERROR FLAG FOR AN OFF OR
*                SUSPECT DEVICE IF THE *READSYS* BIT IS SET IN *CHRV*.
*         SLM    SECTOR LIMIT.
*         MSD    MASS STORAGE DESIGNATOR BYTE.
*                DRIVER INDEX WILL BE CLEARED FOR SUBFUNCTIONS *PIO*
*                AND *PIOCH*.  BIT 2**6 SET IF DEVICE INACCESSIBLE
*                AND JOB NOT *UTL=* OR IN UNCONDITIONAL TERMINATION
*                STATE.  BIT 2**11 SET IF JOB NOT SUBSYSTEM, NOT
*                *UTL=*, AND NOT IN UNCONDITIONAL TERMINATION STATE.
*         CHRV   CHRV IS UPDATED DEPENDING ON THE SUBFUNCTION.
*                1000 BIT SET FOR *READSTR* OPTION.
*                40 BIT SET FOR *READSYS* OPTION ON A SYSTEM DEVICE.
*                4 BIT SET IF ACCESS SHOULD BE ALLOWED TO A SUSPECT
*                OR OFF DEVICE.
*                2 BIT SET IF ACCESS SHOULD BE ALLOWED TO A DOWN
*                DEVICE.
*         EST    *EQDE* WORD OF EST ENTRY.
*
*
*         HANG CONDITIONS -
*
*         INCORRECT SUBFUNCTION CODE.
*         EST ORDINAL OUTSIDE OF EST.
*         NON-MASS STORAGE EQUIPMENT (AND NOT *RD* EQUIPMENT).
*         *6DC* REQUEST BIT SET BY NONCONCURRENT PP (NPP).
*         *6DC* REQUEST BIT NOT SET BY CONCURRENT PP (CPP).
*         NOT CALLED BY AN NPP AND THERE ARE NO CPPS.
 
 
          PPR    LMSM
          TB3    A5,-FPC     SUBTRACT *IR* ADDRESS OF FIRST CPP
          MX0    -3          EXTRACT SUBFUNCTION CODE
          SX6    X5          SIGN EXTEND WDSE PRESENT BIT
          AX1    3
          BX2    -X0*X5
          MX0    -12
          AX6    18
          TPL    B3,(/CPP/LMS13,CPP,/MONITOR/HNG)  IF FROM CPP
          BX5    -X0*X1      UERR
          AX1    36-3        EXTRACT EQUIPMENT
          SB4    X1
          TB3    ESTL
          SX4    -B4
          ERRNZ  RDEQ        CODE ASSUMES *RDEQ* = 0
          GE     B4,B3,HNG   IF *6DC* REQUEST OR IF OUTSIDE EST
          SB3    X2          (B3) = SUBFUNCTION CODE
          CX3    X1,EST      CONVERT EST ORDINAL TO OFFSET
          TA3    EQDE+X3,EST READ EST ENTRY
          BX6    -X0*X6      MASK FOR WDSE EXTRACTION
          BX1    -X0*X3
          BX7    X3
          AX7    59-0
          BX7    X4+X7
          SA2    A5+B1       READ WDSE
          NZ     X7,HNG      IF NEITHER MASS STORAGE NOR *RD* EQUIPMENT
          BX7    X3
          SA4    A2+B1       READ MESSAGE BUFFER PARAMETERS
          LX6    36
          LX1    3           MST ADDRESS
          BX6    X6*X2       WDSE TO SAVE FOR REPLY
          SA7    A4+B1       STORE EST IN REPLY
          SX2    EPAD&EPNS
          SX7    211B
          BX2    X2*X5       MAP *AD*/*NS* OPTIONS INTO *CHRV*
          BX7    X7*X4       PRESERVE CHANNEL STATUS FROM *CHRV*
          LX5    36
          BX7    X2+X7       COMBINE OLD AND NEW *CHRV* DATA
          SA1    X1+MDGL
          BX7    X7+X5       COMBINE *CHRV* AND *UERR*
          BX2    -X0*X1
          SX5    370000B
          LX2    24          POSITION *SLM*
          BX7    X7+X2
          BX4    X5*X4       OLD DRIVER INDEX
          LX3    59-58
          BX5    X5*X1       NEW DRIVER INDEX
          LX1    59-47+12
          SA2    B7+SEPW     CHECK SPECIAL ENTRY POINTS
          BX1    -X0*X1
          AX1    11          POSITION INTERLACE
          LX2    59-56
          SB6    X1
          NG     X2,LMS3     IF *UTL=* ENTRY POINT
          SA2    B7+TFSW
          LX2    12
          BX1    -X0*X2
          CX2    X1,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA2    X2+SCHE,EJT
          LX2    59-34
          ERRNZ  UCTM-2      CODE ASSUMES VALUE
          NG     X2,LMS3     IF UNCONDITIONAL JOB TERMINATION
          SA2    B7+JCIW     CHECK SUBSYSTEM
          LX2    -24
          BX2    -X0*X2
          SX2    X2-LSSI-1
          MX1    1
          BX2    X1*X2
          LX2    23-59
          BX7    X7+X2       SET SUBSYSTEM STATUS
          SA2    A1+DALL-MDGL
          R=     B4,.READSYS
          NE     B3,B4,LMS2  IF NOT *READSYS* OPTION
          NG     X3,LMS3     IF SYSTEM DEVICE
          SA3    INWL
 LMS2     LX2    59-55
          LX3    59-15
          BX2    X1*X2
          NG     X3,LMS3     IF DEADSTART SEQUENCING NOT COMPLETE
          LX2    18-59
          BX7    X7+X2       SET SUSPECT STATUS
 LMS3     SX0    11B
          PX3    X7,B6       SET INTERLACE
          BX1    X1-X1
          NZ     B3,LMS12    IF NOT FUNCTION 0
 
*         CHECK FOR DRIVER LOAD NEEDED.
 
 LMS4     IX2    X4-X5       OLD INDEX - NEW INDEX
          BX1    X0*X3       *CHRV* CHANNEL STATUS
          SX7    B1+B1       SET STATUS REPLY
          IX2    X1+X2
          ZR     X2,LMS4.1   IF CORRECT DRIVER AND NO CHANNEL RESERVE
          BX6    X6+X7       SET TO NOT EXECUTE DRIVER PRESET
          MX0    18+12
          NZ     X1,LMS5     IF CHANNEL RESERVED
          BX4    X5          SET NEW DRIVER INDEX
          AX5    12
          SA1    TMSD+X5     READ DRIVER LOAD
          LX0    -18
          SX1    X1          SET PLD ADDRESS
          ZR     X1,LMS9     IF LIBRARY LOCKED
          ZR     X5,HNG      IF ILLEGAL DRIVER INDEX
          SX5    X5-LA6MX
          PL     X5,HNG      IF ILLEGAL DRIVER INDEX
          SA2    X1
          SX1    B1
          BX2    X0*X2       CLEAR LOAD ADDRESS AND PROGRAM NAME
          LX1    41
 LMS4.1   IX2    X1+X2
          BX6    -X7*X6      SET TO EXECUTE DRIVER PRESET
          BX7    X7+X2
          SA1    A3+B1
          ERRNZ  EQDE+1-EQAE CODE DEPENDS ON VALUE
          MX5    12
          LX1    24
          BX5    X5*X1       EXTRACT DEVICE PARAMETER FROM EST
          BX6    X5+X6
          ERRNZ  .PIO-1      CODE ASSUMES *.PIO* = 1
 LMS5     NE     B3,B1,LMS6  IF NOT *PIO*/*PIOCH* SUBFUNCTION
          SX4    0           CLEAR DRIVER INDEX IN *MSD*
 LMS6     SA6    A5+B1       STORE MB REPLY
          BX6    X3+X4       MERGE DRIVER INDEX
          SA6    A6+B1       STORE MB+1 REPLY
          SA7    A5          STORE OUTPUT REGISTER
          EQ     PPRX        RETURN
 
 LMS7     PL     X3,LMS8     IF NOT SYSTEM DEVICE
          SX1    40B
 LMS8     BX3    X7+X1
          EQ     LMS4        CHECK FOR DRIVER LOAD
 
 LMS9     SA5    A5          REJECT REQUEST
          MX7    1
          BX7    X5+X7
          SA7    A5
          EQ     PPRX        RETURN
 
 LMS10    SX7    B1+B1       SET REPLY STATUS
          BX6    X6+X7       SET NO DRIVER PRESET
          SA6    A5+B1       STORE MB REPLY
          SA7    A5
          EQ     PPRX        RETURN
 
 LMS11    SB3    .PIO
          EQ     TLMS+.IOCH  GO TO *IOCH* PROCESSOR
 
 LMS12    BX7    X3          SAVE MB+1 IMAGE
          SX1    B0
          JP     TLMS+B3     JUMP TO PROCESSOR
 
          BSS    0
          QUAL
 TLMS     EQU    *-1         TABLE OF *LMSM* SUBFUNCTION PROCESSORS
          LOC    1
 .PIO     SX5    LA6DI*4096  SUBFUNCTION 1 - *PIO*
          EQ     /MONITOR/LMS4  LOAD DRIVER
 
 .PIOCH   SX5    LA6DI*4096  SUBFUNCTION 2 - *PIOCH*
          EQ     /MONITOR/LMS11 EQUATE THIS SUBFUNCTION TO *PIO*
 
 .READSYS SA3    A3          SUBFUNCTION 3 - *READSYS*
          LX3    59-58
          EQ     /MONITOR/LMS7  SET SYSTEM SEARCH FLAG
 
 .READSTR SX1    1000B       SUBFUNCTION 4 - *READSTR*
          EQ     /MONITOR/LMS8  CHECK DRIVER LOAD
 
 .STATUS  BX7    X7+X4       SUBFUNCTION 5 - *STATUS*
          SA7    A4          STORE MB+1 REPLY
          EQ     /MONITOR/LMS10  COMPLETE FUNCION
 
 .IOCH    SX1    20B         SUBFUNCTION 6 - *IOCH*
          EQ     /MONITOR/LMS8  CONTINUE
 
+         EQ     /MONITOR/HNG  SUBFUNCTION 7 - INVALID
          LOC    *O
          QUAL   *
 MTEM     SPACE  4,15
***       MTEM - *MTE* FUNCTION REQUEST PROCESSOR.
*
*         ENTRY
*T, OR    12/  MTEM,12/  SF,36/ PARAMETERS
*
*         SF     SUBFUNCTION CODE.
*                CBRS  CLEAR BAT READ ACCESS.
*                CBWS  CLEAR BAT READ AND WRITE ACCESS.
*                CEMS  CLEAR EXTENDED MEMORY TRACK.
*                EBRS  ENABLE BRT PROCESSING.
*                SEPS  SET *DAS* ERROR PROCESSING INTERLOCK.
*                CEPS  CLEAR *DAS* ERROR PROCESSING INTERLOCK.
*                SRIS  SET RECOVERY ERROR PROCESSING INTERLOCK.
*                CRIS  CLEAR RECOVERY ERROR PROCESSING INTERLOCK.
*                RBPS  RELEASE BAT/BST ACCESS PERMISSIONS.
*                GRIS  GET RECOVERY INTERLOCK STATUS.
*                SRPS  SET *DAS* RESTORE PARITY INTERLOCK.
*                CRPS  CLEAR *DAS* RESTORE PARITY INTERLOCK.
*                GBDS  GET *BDT* ENTRY.
*
*
*         CBRS/CBWS - CLEAR BAT READ/WRITE ACCESS.
*
*         ENTRY
*T, OR    12/  MTEM,12/  SF,12/  MI,12/  0,12/  EQ
*         SF     *CBRS*/*CBWS* SUBFUNCTION.
*         MI     MAINFRAME INDEX FOR THE MAINFRAME BEING RECOVERED.
*         EQ     EST ORDINAL FOR THE DEVICE BEING RECOVERED.
*
*         EXIT
*T, OR    12/  0,48/  UNCHANGED
*
*         *PP HUNG.* WILL OCCUR FOR THE FOLLOWING CONDITIONS -
*         1. THE SPECIFIED DEVICE IS NOT A SHARED BUFFERED DEVICE.
*         2. THE SPECIFIED DEVICE IS NOT IN THE *DAT*.
*         3. MACHINE INDEX IS INVALID.
*
*
*         EBRS - ENABLE BRT PROCESSING.
*
*         ENTRY
*T, OR    12/  MTEM,12/  *EBRS*,12/  0,12/  BD,12/  BT
*         BD     TRACK NUMBER OF BDT IN EXTENDED MEMORY.
*         BT     TRACK NUMBER OF BRT IN EXTENDED MEMORY.
*
*         EXIT
*T, OR    12/  0,48/  UNCHANGED
*
*
*         CEMS - CLEAR EXTENDED MEMORY TRACK.
*
*         ENTRY
*T, OR    12/  MTEM,12/  *CEMS*,12/  FS,12/  NS,12/  TK
*         FS     FIRST SECTOR TO CLEAR.
*         NS     NUMBER OF SECTORS TO CLEAR.
*         TK     EXTENDED MEMORY TRACK TO CLEAR.
*
*         EXIT
*T, OR    12/  0,48/  UNCHANGED
*
*         *PP HUNG.* WILL OCCUR IF THE LAST SECTOR TO CLEAR
*         IS PAST THE TRACK BOUNDARY OF THE SPECIFIED TRACK.
*
*
*         SEPS - SET *DAS* ERROR PROCESSING INTERLOCK.
*
*         ENTRY
*T, OR    12/  MTEM,12/ *SEPS*,24/  0,12/  EQ
*         EQ     EST ORDINAL OF DEVICE TO BE PROCESSED.
*
*         EXIT
*T, OR    12/  0,36/  UNCHANGED,12/  ST
*         ST     STATUS = 0, IF SUCCESSFUL.
*                       = 1, IF REJECT.
*
*         *PP HUNG.* WILL OCCUR FOR THE FOLLOWING CONDITIONS -
*         1. THE SPECIFIED DEVICE IS NOT A SHARED BUFFERED DEVICE.
*         2. THE SPECIFIED DEVICE IS NOT IN THE *DAT*.
*
*
*         CEPS - CLEAR *DAS* ERROR PROCESSING INTERLOCK.
*
*         ENTRY
*T, OR    12/  MTEM,12/  *CEPS*,24/  0,12/  EQ
*         EQ     EST ORDINAL OF DEVICE TO BE PROCESSED.
*
*         EXIT
*T, OR    12/  0,36/  UNCHANGED,12/  0
*
*         *PP HUNG.* WILL OCCUR FOR THE FOLLOWING CONDITIONS -
*         1. THE SPECIFIED DEVICE IS NOT A SHARED BUFFERED DEVICE.
*         2. THE SPECIFIED DEVICE IS NOT IN THE *DAT*.
*
*
*         SRIS - SET RECOVERY ERROR PROCESSING INTERLOCK.
*
*         ENTRY
*T, OR    12/  MTEM,12/  *SRIS*,36/  0
*
*         EXIT
*T, OR    12/  0,36/  UNCHANGED,12/  ST
*         ST     STATUS = 0, IF SUCCESSFUL.
*                       = 1, IF INCOMPLETE (RECOVERY INTERLOCK IS SET,
*                            BUT CONFLICTING *BDT* INTERLOCKS ARE SET).
*                       = 2, IF REJECT.
*
*
*         CRIS - CLEAR RECOVERY ERROR PROCESSING INTERLOCK.
*
*         ENTRY
*T, OR    12/  MTEM,12/  *CRIS*,36/  0
*
*         EXIT
*T, OR    12/  0,48/  UNCHANGED
*
*
*         RBPS - RELEASE BAT/BST ACCESS PERMISSIONS.
*
*         ENTRY
*T, OR    12/  MTEM,12/  *RBPS*,24/  0,12/  EQ
*         EQ     EST ORDINAL FOR THE DEVICE TO BE PROCESSED.
*
*         EXIT
*T, OR    12/  0,36/  UNCHANGED,12/  ST
*         ST     STATUS .EQ. 0, IF SUCCESSFUL.
*                       .NE. 0, IF NOT ALL PERMISSIONS WERE RELEASED.
*
*         *PP HUNG.* WILL OCCUR FOR THE FOLLOWING CONDITIONS -
*         1. THE SPECIFIED DEVICE IS NOT A SHARED BUFFERED DEVICE.
*         2. THE SPECIFIED DEVICE IS NOT IN THE *DAT*.
*
*
*         GRIS - GET RECOVERY INTERLOCK STATUS.
*
*         ENTRY
*T, OR    12/  MTEM,12/  *GRIS*,36/  0
*
*         EXIT
*T, OR    12/  0,36/  UNCHANGED,12/  ST
*         ST     STATUS = 0, IF NO CONFLICTING *BDT* INTERLOCKS SET.
*                       = 1, IF CONFLICTING *BDT* INTERLOCKS STILL SET.
*
*
*         SRPS - SET *DAS* RESTORE PARITY INTERLOCK.
*
*         ENTRY
*T, OR    12/  MTEM,12/  *SRPS*,24/  0,12/  EQ
*T, MB    24/ ,36/ CID
*         EQ     EST ORDINAL FOR THE DEVICE TO BE PROCESSED.
*         CID    SERIAL NUMBER FOR CONTROLLER PERFORMING *RESTORE*.
*
*         EXIT
*T, OR    12/  0,36/  UNCHANGED,12/  ST
*         ST     STATUS .EQ. 0, IF SUCCESSFUL.
*                       .NE. 0, IF REJECT.
*
*         *PP HUNG.* WILL OCCUR FOR THE FOLLOWING CONDITIONS -
*         1. THE SPECIFIED DEVICE IS NOT A SHARED BUFFERED DEVICE.
*         2. THE SPECIFIED DEVICE IS NOT IN THE *DAT*.
*
*
*         CRPS - CLEAR *DAS* RESTORE PARITY INTERLOCK.
*
*         ENTRY
*T, OR    12/  MTEM,12/  *CRPS*,24/  0,12/  EQ
*         EQ     EST ORDINAL FOR THE DEVICE TO BE PROCESSED.
*         CID    CONTROLLER SERIAL NUMBER (FOR *SRPS*).
*
*         EXIT
*T, OR    12/  0,48/  UNCHANGED
*
*         *PP HUNG.* WILL OCCUR FOR THE FOLLOWING CONDITIONS -
*         1. THE SPECIFIED DEVICE IS NOT A SHARED BUFFERED DEVICE.
*         2. THE SPECIFIED DEVICE IS NOT IN THE *DAT*.
*
*
*         GBDS - GET *BDT* ENTRY.
*
*         ENTRY
*T, OR    12/  MTEM,12/  *GCIS*,24/  0,12/  EQ
*         EQ     EST ORDINAL FOR THE DEVICE TO BE PROCESSED.
*
*         EXIT
*T, OR    12/  0,48/  UNCHANGED
*T, MB    60/ BDT
*         BDT    BDT ENTRY FOR SPECIFIED DEVICE (SEE *COMSMMF*).
*
*         *PP HUNG.* WILL OCCUR FOR THE FOLLOWING CONDITIONS -
*         1. THE SPECIFIED DEVICE IS NOT A SHARED BUFFERED DEVICE.
*         2. THE SPECIFIED DEVICE IS NOT IN THE *DAT*.
 
 
          PPR    MTEM,(/BUFIO/MTE,BIOMMF,/MONITOR/HNG)
 
 
 MTRM     SPACE  4,35
***       MTRM - MANAGE TABLE REQUEST PROCESSOR.
*
*         ENTRY
*T, OR    12/ MTRM,12/ FPARM,1/ SF,11/ TABLE,24/
*T, MB    60/ FWORD
*
*         FPARM  FUNCTION PARAMETER.
*                = 0, IF RESERVE TABLE ENTRY FOR USE (REMOVE AN ENTRY
*                FROM POOL OF AVAILABLE ENTRIES FOR THIS TABLE).
*                = ORDINAL, IF NONZERO.  TABLE ENTRY SPECIFIED WILL
*                BE RETURNED TO POOL OF AVAILABLE ENTRIES.
*         SF     SYSTEM JOB FLAG.
*                IF SET, AND *FPARM* = 0, ONE OF THE *RESERVED FOR
*                SYSTEM JOB* ENTRIES WILL BE ASSIGNED IF THE TABLE
*                IS FULL.
*         TABLE  TABLE IDENTIFICATION.
*                *PEJT* IF EJT ENTRY TO BE PROCESSED.
*                *PFNT* IF SYSTEM FNT ENTRY TO BE PROCESSED.
*                *PFOT* IF FAMILY ORDINAL TABLE TO BE PROCESSED.
*                *PQFT* IF QFT ENTRY TO BE PROCESSED.
*                *PODT* IF ORT ENTRY TO BE PROCESSED.
*
*         FWORD  INFORMATION TO STORE IN FIRST WORD OF TABLE
*                ENTRY RESERVED FOR *FPARM* = 0 REQUEST.
*
*         EXIT
*T, OR    12/ 0,12/ STAT,12/,24/ ADDR
*
*         STAT   RETURN STATUS.
*                = 0 FOR *FPARM* = ORDINAL OPTION.
*                = 0 FOR *FPARM* = 0 OPTION, IF NO TABLE ENTRY
*                AVAILABLE.
*                = ORDINAL FOR *FPARM* = 0 OPTION, IF THIS TABLE
*                ENTRY HAS BEEN RESERVED FOR USE BY CALLER.
*         ADDR   ABSOLUTE ADDRESS OF TABLE ENTRY RESERVED FOR
*                USE FOR *FPARM* = 0 OPTION.
*
*         *PP HUNG* WILL OCCUR FOR THE FOLLOWING CONDITIONS.
*         1.  INVALID TABLE IDENTIFICATION.
*         2.  ORDINAL OF ENTRY TO RETURN TO POOL IS INVALID.
*         3.  ENTRY TO RETURN TO POOL IS NOT IN USE (BYTE 0 = 0).
 
 
          PPR    MTRM,,,FEX
 
          SB6    PPR1        SET *MTRM* EXIT ADDRESS
 
*         ENTRY FROM *JACM* AND *RJSM* PROCESSORS.
*                (B6) = RETURN ADDRESS.
 
 MTM0     AX1    24
          MX3    -11
          MX0    -12
          BX6    -X0*X1      SYSTEM JOB FLAG
          BX2    -X3*X1      TABLE IDENTIFICATION
          AX1    12
          SX2    X2-PFOT
          SX3    X2-TMTDL
          BX3    -X3+X2
          SB3    -B1         DECREMENT NUMBER OF FREE ENTRIES
          NG     X3,HNG      IF INVALID TABLE IDENTIFICATION
          SA4    TMTD+X2     GET TABLE POINTER AND ENTRY LENGTH
          BX5    -X0*X4
          AX4    12
          BX7    -X0*X4
          SB4    X7          NUMBER OF RESERVED ENTRIES
          AX4    12
          SA4    X4          GET TABLE FWA AND LINKED LIST POINTER
          LX4    -12
          BX2    -X0*X4      COUNT OF AVAILABLE ENTRIES
          LX4    -24
          NZ     X1,MTM1     IF RETURN ENTRY TO AVAILABLE POOL
 
*         REMOVE ENTRY FROM POOL OF AVAILABLE ENTRIES.
 
          SA3    A4          GET FIRST AVAILABLE ENTRY
          BX7    -X0*X3
          ZR     X7,PPR1     IF NO ENTRIES AVAILABLE
          SX1    B4
          IX2    X1-X2
          NG     X2,MTM0.1   IF TABLE NOT FULL
          AX6    11
          NZ     X6,MTM0.1   IF SYSTEM JOB CALL
          SX7    B0+
          EQ     PPR1        CLEAR OUTPUT REGISTER
 
 MTM0.1   SX4    X4
          IX5    X7*X5
          IX5    X5+X4       ABSOLUTE ADDRESS OF FIRST AVAILABLE ENTRY
          SA2    A5+B1       RESERVE NEXT AVAILABLE ENTRY
          LX7    36
          SA1    X5          GET NEXT LINK
          BX7    X7+X5
          LX6    X2
          BX1    -X0*X1
          EQ     MTM4        UPDATE POINTER FOR NEXT AVAILABLE ENTRY
 
*         RETURN ENTRY TO POOL OF AVAILABLE ENTRIES.
 
 MTM1     LX4    12
          BX2    -X0*X4      MAXIMUM NUMBER OF ENTRIES
          SX7    A4+
          LX4    -12
          IX2    X1-X2
          PL     X2,HNG      IF ORDINAL OUT OF RANGE
 MTM2     SA3    X7
          MX2    1
          BX6    -X0*X3
          IX7    X6*X5
          ZR     X6,MTM3     IF END OF LINKED LIST
          IX2    X1-X6
          IX7    X7+X4
 MTM3     PL     X2,MTM2     IF ORDINAL .GT. NEXT POINTER
          SB4    X5
          IX5    X1*X5
          SB3    B1          INCREMENT NUMBER OF FREE ENTRIES
          IX5    X5+X4       ABSOLUTE ADDRESS OF ENTRY TO RETURN
          BX7    X7-X7
          SA2    X5          CHECK IF ENTRY ALREADY IN POOL
          LX2    12
          BX2    -X0*X2
          ZR     X2,HNG      IF ENTRY IS NOT IN USE
 MTM4     BX3    X0*X3       ADD/REMOVE ENTRY IN LIST
          SX2    B3
          LX2    12
+         SA6    X5          UPDATE TABLE IN ONE WORD OF CODE
          BX6    X3+X1
          SA6    A3
          SA4    A4
          IX6    X4+X2       INCREMENT/DECREMENT FREE ENTRIES
          SA6    A4
          NZ     X7,RB6      IF NOT CLEARING ENTRY
 MTM5     SB4    B4-B1       CLEAR REMAINDER OF ENTRY
          SA7    X5+B4
          GT     B4,B1,MTM5  IF MORE WORDS TO CLEAR
          JP     B6          EXIT
 TMTD     SPACE  4,10
**        TMTD - TABLE OF MANAGED TABLE DESCRIPTORS.
*
*         ONE WORD PER ENTRY -
*T        18/,18/ PTRA,12/ RSEN,12/ ENTL
*         PTRA   MANAGED TABLE POINTER ADDRESS.
*         RSEN   NUMBER OF ENTRIES RESERVED FOR SYSTEM JOBS.
*         ENTL   TABLE ENTRY LENGTH.
 
 
 TMTD     BSS    0
          LOC    1
          ERRNZ  *-PFOT      TABLE POSITION DEPENDS ON VALUE
          VFD    18/0,18/FOTP,12/0,12/1  FAMILY ORDINAL TABLE
          ERRNZ  *-PFNT      TABLE POSITION DEPENDS ON VALUE
          VFD    18/0,18/FNTP,12/0,12/FNTE  SYSTEM FNT
          ERRNZ  *-PQFT      TABLE POSITION DEPENDS ON VALUE
          VFD    18/0,18/QFTP,12/QFTR,12/QFTE  QUEUE FILE TABLE
          ERRNZ  *-PEJT      TABLE POSITION DEPENDS ON VALUE
          VFD    18/0,18/EJTP,12/EJTR,12/EJTE  EXECUTING JOB TABLE
          ERRNZ  *-PODT      TABLE POSITION DEPENDS ON VALUE
          VFD    18/0,18/ORTP,12/0,12/ORTE  OPTICAL DISK REQUEST TABLE
          LOC    *O
 TMTDL    EQU    *-TMTD      TABLE LENGTH
 PIOM     SPACE  4,20
***       PIOM - PP I/O VIA CPU TRANSFERS.
*
*         ENTRY
*
*         FOR PP I/O BUFFER SUBFUNCTIONS (SF = 0, 1, 2) -
*T, OR    12/  PIOM,6/  SF,6/  FF,24/,12/  CH
*T, MB    12/  T4,12/  T5,12/  T6,12/  T7,12/  CHRV
*
*         FOR DIRECT READ OR WRITE OF SPECIFIED NUMBER OF SECTORS
*         (SF = 3 WITH FF BIT 38 = 0, AND SF = 4) -
*T, OR    12/  PIOM,6/  SF,6/  FF,12/  SC,6/,18/  CMR
*T, MB    12/  T4,12/  T5,12/  T6,12/  T7,12/  CHRV
*
*         FOR DIRECT READ TO EOR (SF = 3 WITH FF BIT 38 = 1) -
*T, OR    12/  PIOM,6/  SF,6/  FF,18/   LWR,18/  CMR
*T, MB    12/  T4,12/  T5,12/  T6,12/  T7,12/  CHRV
*
*         FOR WRITE BUFFER FLUSH (SF = 5) -
*T, OR    12/  PIOM,6/  SF,6/,24/,12/  FNTO
*
*         FOR CM RESIDENT CODE TRANSFER SUBFUNCTION (SF = 6) -
*T, OR    12/  PIOM,6/  SF,6/,18/  LWR,18/  CMR
*T, MB    24/,24/ CMA,12/
*
*         SF     SUBFUNCTION CODE AS DEFINED IN *COMSCPS*.
*                SUBFUNCTIONS 0 THRU 4 APPLY TO ECS/LCM (DE)
*                AND BUFFERED I/O DEVICES (DV, DW, DB, DC, ETC.).
*                SUBFUNCTION 5 APPLIES TO 819 EQUIPMENT ONLY.
*                SUBFUNCTION 6 APPLIES TO CM RESIDENT CODE ONLY.
*                0 = REBS = RESERVE WRITE BUFFER.
*                1 = RESS = READ SECTOR.
*                2 = WESS = WRITE SECTOR.
*                3 = RDDS = READ DIRECT.
*                4 = WDDS = WRITE DIRECT.
*                5 = FLBS = FLUSH 819 I/O LCM BUFFERS.
*                6 = LCRS = LOAD CM RESIDENT CODE.
*         FF     FUNCTION FLAGS.
*                BIT 36 = REWRITE (SF = 2 ONLY).
*                BIT 37 = LAST SECTOR BUFFER FLUSH FOR SECTOR WRITE
*                   (SF = 2), WRITE EOI AND FLUSH BUFFER FOR DIRECT
*                   WRITE ON BUFFERED DEVICE (SF = 4).
*                BIT 38 = READ TO EOR (SF = 3 ONLY), TERMINATES ON
*                   ANY SHORT SECTOR - EOR/EOF/EOI.
*         CH     CHANNEL NUMBER TO BE USED IN PROCESSING REQUEST, VALID
*                ONLY WHEN BIT 4 OF *CHRV* IS SET.
*         SC     SECTOR COUNT TO BE TRANSFERRED (SF = 3 WITH
*                FF BIT 38 = 0 AND SF =4).
*         LWR    LWA+1 OF TRANSFER (SF = 3 WITH FF BIT 38 = 1
*                AND SF = 6).  IF ZERO, LWA+1 TRANSFER = FL.
*         CMR    RELATIVE CM ADDRESS OF TRANSFER (SF = 3, 4, 6 ONLY).
*         T4     PP I/O BUFFER INCREMENT, IF PP I/O BUFFER RESERVED.
*         T5     EQUIPMENT (EST ORDINAL OF ECS/LCM OR BUFFERED DEVICE).
*         T6     CURRENT TRACK (LOGICAL).
*         T7     CURRENT SECTOR (LOGICAL).
*         CMA    ABSOLUTE CM ADDRESS OF CM RESIDENT CODE TO TRANSFER.
*         CHRV   CHANNEL RESERVATION INDICATOR.
*                BIT 5 = SYSTEM FILE REQUEST.
*                BIT 6 = PP I/O BUFFER RESERVED (BUFFER
*                   INCREMENT IN T4).
*                BIT 7 = BUFFER I/O LINK SET.
*                BIT 8 = DIRECT TRANSFER CONTINUATION (CLEAR IF
*                   INITIAL CALL).
*                BIT 9 = STREAM DATA ON PRU READ.
*         FNTO   FNT ORDINAL FOR FNT NEEDING A BUFFER FLUSHED.
*
*         EXIT
*
*         FOR PP I/O BUFFER SUBFUNCTIONS (SF = 0, 1, 2) -
*T, OR    12/  0,6/  ST,6/  EC,6/,30/  EEA
*T, MB    12/  T4,12/  T5,12/  T6,12/  T7,12/  CHRV
*T, MB+1  60/  SAME AS (OR).
*
*         FOR DIRECT READ OR WRITE OF SPECIFIED NUMBER OF SECTORS
*         (SF = 3 WITH FF BIT 38 = 0, AND SF = 4) -
*T, OR    12/  0,6/  ST,6/  EC,12/  SC,6/,18/  CMR
*T, MB    12/  T4, 12/  T5, 12/  T6, 12/  T7, 12/  CHRV
*T, MB+1  60/  SAME AS (OR)
*
*         FOR DIRECT READ TO EOR (SF = 3 WITH FF BIT 38 = 1) -
*T, OR    12/  0,6/  ST,6/  EC,18/  LWR,18/  CMR
*T, MB    12/  T4,12/  T5,12/  T6,12/  T7,12/  CHRV
*T, MB+1  60/  SAME AS (OR)
*
*         FOR WRITE BUFFER FLUSH (SF = 5) =
*T, OR    60/  0
*
*         FOR CM RESIDENT CODE TRANSFER SUBFUNCTION (SF = 6) -
*T, OR    12/  0,6/  ST,6/,18/  LWR,18/  CMR
*T, MB    30/,18/  CMA,12/
*
*         ST     RETURN STATUS.  IF A NONZERO STATUS IS PRESENT, THE
*                ERROR CODE FIELD IS ALWAYS CLEAR.
*                04XX = *IFLS* = INSUFFICIENT FIELD LENGTH FOR LOAD
*                   (SF = 3 WITH FF BIT 38 = 1, OR SF = 6).
*                60XX = *REIS* = REISSUE FUNCTION (SET IN MB+1 ONLY,
*                   I/O OR *PAUSE* IS REQUIRED) (SF = 0, 1, 2, 3, 4).
*         EC     ERROR CODE.  SEE *COMSMSP* FOR A DESCRIPTION OF MASS
*                STORAGE ERROR CODES.
*         SC     REMAINING SECTOR COUNT (SF = 3, 4 ONLY).
*         LWR    SAME AS ON ENTRY.
*         CMR    RELATIVE CM ADDRESS UPDATED TO LWA+1 TRANSFER
*                (SF = 3, 4, 6 ONLY).
*         EEA    ERROR ADDRESS IF ECS/ESM ERROR.
*         T4     PP I/O BUFFER INCREMENT, IF BUFFER RESERVED
*                (SF = 0, 1, 2).
*                NUMBER OF SECTORS TRANSFERRED (SF = 3, 4).
*         T5     EQUIPMENT.
*         T6     TRACK.  UPDATED TO NEXT TRACK, IF NECESSARY,
*                FOR DIRECT TRANSFER (SF = 3, 4).  NOT ADVANCED
*                PAST EOI TRACK.
*         T7     SECTOR.  UPDATED TO NEXT SECTOR, FOR DIRECT
*                TRANSFER (SF = 3, 4).  NOT ADVANCED PAST EOI SECTOR.
*         CMA    SAME AS ON ENTRY.
*         CHRV   BITS UPDATED TO REFLECT CURRENT RESERVATION
*                STATUS.
*
*         NOTES  1.  MB+1 IS USED BY CPUMTR TO KEEP PROGRAM OR
*                    MONITOR MODE FLAGS.  MB+2 AND MB+3 ARE USED
*                    TO CONTAIN A PSEUDO FNT FOR A BUFFERED DISK
*                    REQUEST.
*
*                2.  IF *RCLS* STATUS IS RETURNED, THE PP SHOULD
*                    LOOP ISSUING *PAUSE* AND CHECKING MB+1 BYTE 1
*                    UNTIL STATUS = *REIS*.  BIT 46 OF MB+1 IS SET
*                    WHEN A *PAUSE* IS REQUIRED OR PENDING BUFFERED I/O
*                    IS COMPLETE.  THE *PIOM* FUNCTION SHOULD THEN BE
*                    REISSUED TO COMPLETE THE TRANSFER.  NOTE THAT A
*                    DIRECT TRANSFER IS PREMATURELY TERMINATED IF
*                    NONZERO STATUS IS RETURNED.
*
*                3.  THE PP SHOULD RELEASE THE PP I/O BUFFER AFTER
*                    TRANSFER OF SECTOR TO PP IS COMPLETE (SF = 1).
*                    DRIVER *ENDMS* PROCESSING SHOULD RELEASE THE
*                    PP I/O BUFFER IF IT IS RESERVED.  CPUMTR WILL
*                    RELEASE THE BUFFER IN THE FOLLOWING CASES -
*                    (1)  DIRECT TRANSFER IS REQUESTED (SF = 3, 4).
*                    (2)  BUFFERED I/O IS PENDING (ST = 4000).
*                    (3)  ADDRESS ERROR, I/O ERROR OR INACCESSIBLE
*                         DEVICE.
*                    (4)  LAST SECTOR BUFFER FLUSH REQUESTED ON
*                         WRITE (SF = 2).
*                    NOTE THAT THE PP WILL HAVE TO RE-RESERVE AN
*                    I/O BUFFER (SF = 0) AND REWRITE THE DATA TO
*                    THE BUFFER FOR SF = 2, WHEN BUFFERED I/O IS
*                    PENDING (ST = 4000).
*
*                4.  *PIOM* WILL HANG FOR FOLLOWING CONDITIONS -
*                    (1)  ILLEGAL SUBFUNCTION CODE.
*                    (2)  *CHRV* BIT 0 SET INDICATING PP I/O BUFFER
*                         RESERVED, BUT BUFFER INTERLOCK DOES NOT
*                         CORRESPOND TO THIS PP.
*                    (3)  SF = 0 AND PP I/O BUFFER PREVIOUSLY
*                         RESERVED.
*                    (4)  SF = 2 AND PP I/O BUFFER NOT PREVIOUSLY
*                         RESERVED.
*                    (5)  SECTOR SPECIFICATION INVALID.
*                    (6)  EOR, EOF, OR EOI ENCOUNTERED ON DIRECT READ
*                         WITH SECTOR COUNT (SF = 3).
*                    (7)  NEXT TRACK IS NOT RESERVED, WHEN DIRECT
*                         TRANSFER HAS TO CROSS LOGICAL TRACK
*                         BOUNDARY.
*                    (8)  LWA+1 LOAD .GT. FL (SF = 3 WITH FF BIT
*                         38 = 1, OR SF = 6).
*                    (9)  DIRECT TRANSFER OF SPECIFIED NUMBER OF
*                         SECTORS ATTEMPTED BEYOND CP FL.
*                    (10) FUNCTION FLAG SELECTION IS NOT LEGAL FOR
*                         THIS SUBFUNCTION.
*                         READ TO EOR FLAG (BIT 38) ALLOWED ONLY
*                         FOR SF=3.
*                         LAST SECTOR BUFFER FLUSH (BIT 37) ALLOWED
*                         ONLY FOR SF = 0, 2, 4.
*                         REWRITE FLAG (BIT 36) ALLOWED ONLY FOR
*                         SF = 0, 2, 4.
 
 
          PPR    PIOM,,PIP
 
          AX1    42          GET SUBFUNCTION CODE
          MX2    -12
          SB4    X1-LCRS     CHECK FOR CM RESIDENT CODE LOAD
          SB5    X1-1
          TNZ    B4,(/ECS/PIO,ECS,/MONITOR/HNG)  IF NOT CM FUNCTION
          EQ     PMR         SWITCH TO PROGRAM MODE
 
 
          ERRNZ  REBS        CODE DEPENDS ON VALUE
          ERRNZ  RESS-1      CODE DEPENDS ON VALUE
          ERRNZ  WESS-2      CODE DEPENDS ON VALUE
          ERRNZ  RDDS-3      CODE DEPENDS ON VALUE
          ERRNZ  WDDS-4      CODE DEPENDS ON VALUE
          ERRNZ  FLBS-5      CODE DEPENDS ON VALUE
 PLFM     SPACE  4,40
***       PLFM - PROCESS LOCAL FNT ENTRY.
*
*         CREATE OR DELETE LOCAL FNT ENTRY IN NEGATIVE FL.
*
*T OR     12/ PLFM,6/,1/S,2/,3/SF,24/,12/ ADDR
*
*T,MB     42/  FN,18/
*
*         S      CREATE SPECIAL FILE USING ONE OF THE RESERVED FNT
*                ENTRIES.  SEE SYMBOL *SRFE* IN *PPCOM* FOR A LIST
*                OF SPECIAL FILES.
*
*         SF     SUBFUNCTION -
*                DLFS (0)    DELETE LOCAL FNT ENTRY.
*                DLCS (1)    RETURN FILE COUNT.
*                CRFS (2)    CREATE LOCAL FNT ENTRY.
*
*         ADDR   NFL ADDRESS OF FNT ENTRY (SF = DLFS, DLCS).
*
*         FN     FILE NAME (SF = CRFS).
*
*
*T OR     12/ 0,12/ ADDR,12/,12/ COUNT,12/ STAT
*
*         ADDR   NFL ADDRESS OF LOCAL FNT ENTRY (SF = CRFS).
*
*         COUNT  NUMBER OF LOCAL FILES REMAINING ON SAME
*                EQUIPMENT (SF = DLCS).
*
*         STAT   RETURN STATUS (SF = CRFS).
*                0 = FILE CREATED.
*                1 = FILE ALREADY EXISTS.
*                2 = LOCAL FILE LIMIT (MAXIMUM NFL REACHED).
*                4 = NFL INCREASE NEEDED.
*
*
*         WHEN DELETING AN FNT ENTRY (SF = DLFS), IF THE NFL
*         ADDRESS OF THE ENTRY MATCHES THE ADDRESS IN THE FIRST BYTE
*         OF *EOCW* IN THE CONTROL POINT AREA, THAT FIELD IS CLEARED.
 
 
          PPR    PLFM,(/CME/PLF,CME,/0CME/PLF)
 RCLM     SPACE  4,10
***       RCLM - RECALL CPU.
*
*         ENTRY
*T, OR    12/  RCLM,12/,12/,12/,12/
*
*         EXIT
*T, OR    60/  0
 
 
          PPR    RCLM
 
          SA1    B7+CWQW     CHECK RECALL STATUS
          SA7    A5+         CLEAR OUTPUT REGISTER
          SX6    1S4         SET INCREASED PRIORITY FOR JOB
          SA6    IP
          SB3    PPRX        SET *RCC* RETURN ADDRESS
          LX1    59-46
          SB6    B7          SET EXCHANGE PACKAGE ADDRESS
          PL     X1,RCC      IF TO RECALL CPU
          EQ     PPRX        RETURN
 RCPM     SPACE  4
***       RCPM - REQUEST CPU.
*
*         ENTRY
*T, OR    12/  RCPM,12/,12/,12/,12/
*
*         EXIT
*T, OR    60/  0
 
 
          PPR    RCPM
 
*         ENTER HERE FROM RLMM FOR JOB STEP START.
 
          SA1    B7+STSW     READ STATUS
          SA3    SMRL
          SB3    PPRX        SET *RCC* RETURN ADDRESS
          MX0    -12
          BX0    -X0*X3
          SX5    B7          CONTROL POINT ADDRESS
          LX0    7
          AX1    57
          BX5    X5-X0
          SB6    X1+1
          ZR     X5,HNG      IF STORAGE MOVE IN PROGRESS
          ZR     X1,RCP1     IF NO STATUS
          NZ     B6,HNG      IF NOT *I* STATUS
          SA2    A5-B1
          LX1    41
          BX6    X1*X2       CLEAR PP AUTO RECALL
          SA6    A2
 RCP1     SA7    A5          CLEAR OUTPUT REGISTER
          SB6    B7          SET EXCHANGE PACKAGE ADDRESS
          EQ     RCC         RECALL CPU
 RDCM     SPACE  4,25
***       RDCM - REQUEST DATA CONVERSION.
*
*         ENTRY
*T, OR    12/ RDCM, 12/ SF, 36/
*
*         SF = 0 - 6 (RCIS) - CONVERT INTEGER(S) TO F10.3 FORMAT.
*         SF = 7 (RCDS) - CONVERT INTEGER TO F20.3 FORMAT.
*         SF = 10 (RIDS) - INCREMENT PACKED DATE BY SPECIFIED TERM.
*         SF = 11 (REPS) - ENCRYPT PASSWORD.
*
*
*  0 - 6  RCIS - CONVERT INTEGER(S) TO F10.3 FORMAT.
*
*         CONVERT 30 BIT INTEGER TO DISPLAY CODE IN F10.3 FORMAT.
*         CAUTION - ONLY NINE DIGITS OF ACCURACY ARE RETURNED.  VALUES
*         GREATER THAN 999999.999 ARE TRUNCATED TO THE LOW ORDER NINE
*         DIGITS.
*
*         ENTRY
*T, OR    12/  RDCM,12/  C,6/  M,6/  W,24/
*         C = NUMBER OF VALUES TO CONVERT (1-6),
*             IF C=0, ONLY THE VALUE IN MB+0 IS CONVERTED.
*         M = WORD CONTAINING QUARTER NANOUNIT COUNT TO BE CONVERTED TO
*             MILLIUNITS.  THIS WORD IS A 60 BIT VALUE.
*             MB+M-1 POINTS TO THE WORD REQUIRING CONVERSION.
*             IF C=0, M IS IGNORED.
*         W = WORD CONTAINING SRU ACCUMULATOR (1-6).
*             MB+W-1 POINTS TO THE WORD REQUIRING CONVERSION.
*             IF C=0, W IS IGNORED.
*
*T, MB+0  60/ 30 BIT INTEGER (RIGHT JUSTIFIED)
*T, MB+I  60/ 30 BIT INTEGER (RIGHT JUSTIFIED)
*T, MB+5  60/ 30 BIT INTEGER (RIGHT JUSTIFIED)
*
*         EXIT
*T, OR    60/  0
*
*T, MB+0  60/  CONVERSION
*T, MB+I  60/  CONVERSION
*T, MB+5  60/  CONVERSION
*
*
*      7  RDCS - CONVERT INTEGER TO F20.3 FORMAT.
*
*         CONVERT A 60-BIT INTEGER TO DISPLAY CODE IN F20.3 FORMAT.
*         CAUTION - ONLY 15 DIGITS OF ACCURACY ARE RETURNED.  VALUES
*         GREATER THAN 999999999999.999 ARE TRUNCATED TO THE LOW ORDER
*         15 DIGITS.
*
*         ENTRY
*T, OR    12/ RDCM, 12/ RCDS, 6/, 6/ Q, 24/
*         Q = CONVERT QUARTER NANOUNITS TO CYBER 176 CLOCK CYCLES FLAG.
*
*T, MB+0  60/ 60-BIT INTEGER
*
*         EXIT
*T, OR    60/ 0
*
*T, MB+0  60/ CONVERSION (FIRST WORD)
*T, MB+1  60/ CONVERSION (SECOND WORD)
*
*
*     10  RIDS - INCREMENT CURRENT PACKED DATE BY SPECIFIED TERM.
*
*         ENTRY
*T, OR    12/ RDCM, 12/ RIDS, 24/, 12/ TERM
*         TERM - NUMBER OF DAYS TO ADD TO PACKED DATE.
*
*         EXIT
*T, OR    60/ 0
*
*T, MB+0  42/ 0, 18/ NEW PACKED DATE
*
*
*     11  REPS - ENCRYPT PASSWORD.
*
*         ENTRY
*T, OR    12/ RDCM, 12/ REPS, 36/
*
*T, MB+0  60/ PASSWORD
*
*         EXIT
*T, OR    60/ 0
*
*T, MB+0  60/ ENCRYPTED PASSWORD
 
 
          PPR    RDCM,PMR,RDC,FEX
 RECM     SPACE  4,10
**        RECM - RECALL PP REQUEST.
*
*         ENTRY
*T, OR    12/ RECM,1/ ND,11/ RF,36/ RC
*T, MB    60/ IR
*T, MB+1  1/Q,59/ PAR
*
*         IR = INPUT REGISTER OF PP, CONTROL POINT NEED NOT BE SET.
*         ND = SET IF PP IS NOT TO BE DROPPED.
*         RF = RECALL FUNCTION NUMBER AS DEFINED IN *COMSCPS*.
*         RC = RECALL CRITERION, UNIQUE TO EACH RECALL FUNCTION.
*         RF = RC = 0, IF TO SET 1 SECOND TIMED RECALL.
*         Q  = RECALL FLAG, SET BY *CPUMTR* WHEN CALL IS QUEUED.
*         PAR = PARAMETER DATA TO BE PASSED TO ASSIGNED PP IN *MB*.
*
*         EXIT
*T, OR    12/  0,48/
*
*         HANG CONDITIONS -
*         RECALL FUNCTION IS UNDEFINED.
*         NO-DROP OPTION SELECTED WHEN PP CALLED WITH AUTO-RECALL.
*         PP REQUEST (MB) IS ZERO.
*
*         NOTE -
*         THE AUTO RECALL IN THE CALLING PP-S INPUT
*         REGISTER IS PROPAGATED TO THE RECALLED REQUEST,
*         AND THE AUTO-RECALL BIT (IF ANY) IS CLEARED FROM
*         THE CALLING PP-S INPUT REGISTER IF THE NO-DROP
*         OPTION IS NOT SELECTED.
 
 
          PPR    RECM
 
          SA3    A5+2        FETCH PARAMETER WORD
          LX1    59-47
          BX6    X3
          SA6    AQRA
          SB3    REC5        *AQR* RETURN ADDRESS
          SX0    B1
          SA3    A5-B1       READ INPUT REGISTER
          LX0    41
          BX2    X3*X0       EXTRACT AUTO RECALL BIT
          LX3    59-41
          BX6    X3*X1
          NG     X6,HNG      IF AUTO RECALL AND NO-DROP
          NG     X1,REC1     IF NO-DROP PP
          SB3    .DPPM       *AQR* RETURN ADDRESS
          LX3    41-59
          BX6    -X0*X3      REMOVE AUTO RECALL BIT
          SA6    A3+
 REC1     MX6    1           CLEAR DROP INHIBIT BIT
          BX1    -X6*X1
          BX0    X1
          SA4    A5+B1
          ZR     X4,HNG      IF PP CALL ZERO
          BX6    X2+X4       PROPAGATE AUTO-RECALL BIT
          AX1    48
          SB4    X1-TRECL
          PL     B4,HNG      IF CRITERION OUT OF RANGE
          JP     TREC+TRECL+B4
 
 TREC     BSS    0
          LOC    0
 
+         ZR     X0,REC2     IF DEFAULT CALL - (PTMF)
          EQ     HNG         ILLEGAL CRITERION
 
+         EQ     HNG         (PCBF) - ILLEGAL FROM PP
 
+         SA1    RTCL        COMPUTE EXTRACTION TIME
          EQ     REC6        (PTRF) - TIMED RECALL / NO ROLLOUT
 
+         SA1    RTCL        COMPUTE EXTRACTION TIME
          EQ     REC3        (PTMF) - TIMED RECALL
 
+         EQ     REC7        (PBMF) - BUFFER MANAGER RECALL
 
 TRECL    BSS    0
          LOC    *O
 
*         ENTER HERE FROM *CPUCIO* TO QUEUE *CIO* REQUEST FOR
*         SUSPENDED DETTACHED TERMINAL JOB.
*         ENTER HERE FROM *PRQ* TO REQUEUE *1AJ* WHEN ACTIVITY
*         ON JOB OR JOB INTERLOCK SET.
 
 REC2     SA2    MSCL        GET DEFAULT PP RECALL TIME
          MX0    -12
          AX2    24
          BX2    -X0*X2
          SX0    PTMF        SET TIMED RECALL CRITERION
          LX0    36
          IX0    X2+X0
          LX0    12
          SA1    RTCL
 REC3     MX3    -36         ADD TO REAL TIME CLOCK
          BX1    -X3*X1
          LX1    12
          IX0    X0+X1
 REC4     SA1    B7+STSW     CHECK FOR ROLLOUT
          R=     X2,RQ       SET RECALL QUEUE
          LX1    59-24
          PL     X1,AQR      IF ROLLOUT NOT SET
          LX1    24-59
 
*         PUT ENTRY IN RECALL AREA BUT NOT IN QUEUE WHEN ROLLOUT SET.
 
          MX7    -4
          NO
          BX4    -X7*X1      NEXT FREE RECALL SLOT
          SB4    B7+RCCW-1
          BX7    X7*X1
          SA3    B4+X4       READ NEXT FREE RECALL SLOT
          SA6    A3+RECW-RCCW  STORE REQUEST TO RECALL
          SA4    AQRA        GET PARAMETER WORD
          MX6    1
          BX6    X6+X4       SET RECALL BIT FLAG
          SA6    A3+REPW-RCCW  STORE PARAMETER WORD
          SX3    X3+20B
          IX7    X7+X3
          SA7    A1
          JP     B3          EXIT
 
 REC5     BX7    X7-X7       CLEAR *OR*
          SA7    A5
          EQ     MTRX        EXIT
 
 REC6     MX3    -36
          BX1    -X3*X1
          LX1    12
          IX0    X0+X1
          R=     X2,NRQ      INHIBIT ROLLOUT
          EQ     AQR         ASSIGN QUEUE REQUEST
 
 
 REC7     MX3    -12
          SA4    A5-B1
          LX3    12
          BX3    -X3*X0      CBT ORDINAL PASSED IN *RECM* CALL
          AX3    12-CBTLS
          MX2    -5
          TA3    X3+LSLK,CBT
          LX4    -18
          LX2    18
          BX4    -X2*X4      CONTROL POINT NUMBER OF CALLER
          BX3    -X2*X3      CONTROL POINT NUMBER FROM CBT ENTRY
          R=     X2,BQ       SET BUFFER MANAGER RECALL QUEUE
          BX4    X4-X3       COMPARE CONTROL POINT NUMBERS
          ZR     X4,AQR      IF RECALL STILL SET FOR THIS JOB
          BX7    X7-X7
          SA6    A5-B1       RESET INPUT REGISTER
          SA1    A5+2        RESTORE MB+4
          SA7    A5          CLEAR OR
          BX7    X1
          SA7    A5+5
          EQ     MTRX        RESTART PSEUDO-PP
 REQM     SPACE  4,25
***       REQM - REQUEST EQUIPMENT.
*
*         REQUEST ASSIGNMENT OF EQUIPMENT TO JOB.
*
*         ENTRY
*T, OR    12/  REQM,12/  EQ,12/  SF,12/  EJT,12/
*         EQ     EST ORDINAL (IF 4000B + EQ, EJT IS PRESENT).
*         SF     SUBFUNCTION.
*             =  REQS TO REQUEST ACTIVE NON-MS EQUIPMENT.
*             =  RDES TO REQUEST DOWN EQUIPMENT.
*             =  RVES TO ASSIGN ANY EQUIPMENT.
*         EJT    EJT ORDINAL TO ASSIGN EQUIPMENT TO.
*
*         EXIT
*T, OR    12/  0,12/  ST,12/,12/,12/
*         ST .NE. 0  IF EQUIPMENT ASSIGNED.
*         ST = 0 IF EQUIPMENT NOT AVAILABLE.
*         COUNTER IN *EACW* INCREMENTED, IF EQUIPMENT ASSIGNED TO
*         CALLER.
*
*
*         HANG CONDITIONS -
*
*         INCORRECT EST ORDINAL.
*         INCORRECT SUBFUNCTION.
 
 
          PPR    REQM
 
          LX5    24
          MX2    -9
          BX0    -X2*X5      EST ORDINAL
          LX5    59-47-24
          TX3    X0,-ESTL
          PL     X3,HNG      IF INCORRECT EST ORDINAL
          CX2    X0,EST      CONVERT EST ORDINAL TO OFFSET
          TA2    X2+EQDE,EST READ EST ENTRY
          LX1    36
          TX4    B7,-SCA
          SA3    A2+B1
          ERRNZ  EQDE+1-EQAE CODE DEPENDS ON VALUE
          MX0    -12
          NG     X5,REQ1     IF ALTERNATE EJT SPECIFIED
          MX1    12
          ZR     X4,REQ1     IF PP AT SYSTEM CONTROL POINT
          SA1    B7+TFSW     GET JOB EJT
 REQ1     LX1    12
          BX1    -X0*X1      EJT ORDINAL
          BX6    X1+X3       INSERT EQUIPMENT ASSIGNMENT
          BX3    -X0*X3
          NZ     X3,PPR1     IF EQUIPMENT ALREADY ASSIGNED
          LX5    47-59-24
          BX4    -X0*X5      EXTRACT SUBFUNCTION
          LX3    X2
          SB3    X4-1        CHECK SUBFUNCTION
          LX2    59-49
          PL     X2,REQ2     IF EQUIPMENT ON OR IDLE
          NO
          LX2    1
 REQ2     GT     B3,B1,HNG   IF INVALID SUBFUNCTION
          ERRNZ  RVES-2      CODE DEPENDS ON VALUE
          PL     B3,REQ3     IF NOT *REQS*
          ERRNZ  REQS        CODE DEPENDS ON VALUE
          BX2    X3+X2
          NO
          NG     X2,PPR1     IF EQUIPMENT MASS STORAGE AND/OR DOWN
 REQ3     NZ     B3,REQ4     IF NOT SUBFUNCTION *RDES*
          ERRNZ  RDES-1      CODE DEPENDS ON VALUE
          PL     X2,PPR1     IF EQUIPMENT NOT DOWN
 REQ4     SX7    B1
          LX5    24+59-47
          SA6    A3          STORE EQUIPMENT ASSIGNMENT
          LX7    36
          NG     X5,PPR1     IF ALTERNATE EJT SPECIFIED
          SA1    B7+EACW     UPDATE ASSIGNED EQUIPMENT COUNT
          SX6    B1
          LX6    48
          IX6    X1+X6
          SA6    A1
          EQ     PPR1        RETURN
 RJSM     SPACE  4,20
***       RJSM - REQUEST JOB SEQUENCE NUMBER.
*
*         ASSIGN A JOB SEQUENCE NUMBER.
*
*         ENTRY
*T, OR    12/  RJSM,12/  SF,1/  F,11/  TABLE,12/,12/
*T, MB    24/,36/  QFT ENTRY VALUE
*         SF = 0 IF REQUESTING QFT ENTRY.
*         IF SF = 0,  F = 1 IF SYSTEM JOB CALL (RESERVED QFT ENTRY
*                           WILL BE ASSIGNED IF TABLE FULL).
*         TABLE = *PQFT*.
*
*         EXIT (SF = 0)
*T, OR    RESPONSE FROM *MTRM*
*T, MB    24/  SEQUENCE NUMBER,36/  QFT ENTRY VALUE
*
*         EXIT (SF .NE. 0)
*T, OR    12/  0,12/  SF,12/  PQFT,24/  SEQUENCE NUMBER
*T, MB    24/  SEQUENCE NUMBER,36/  QFT ENTRY VALUE
*
*         *RJSM* HAS BEEN SET UP TO ALLOW A SITE TO AVOID GENERATING
*         POTENTIALLY OFFENSIVE JSN-S BY THE SELECTION OF CHARACTERS
*         WHICH ARE TO BE EXCLUDED FROM EACH CHARACTER POSITION OF
*         JSN-S (VOWELS, FOR EXAMPLE).
 
 
          PPR    RJSM
 
          SA4    JSNL        FETCH CURRENT SEQUENCE NUMBER
          SA3    A5+B1
          MX0    -24
          BX4    -X0*X4
          BX7    X0*X1
          BX7    X7+X4
          LX4    36
          MX0    -36
          BX6    -X0*X3
          BX6    X4+X6
          BX4    X0*X1       GET SUBFUNCTION
          SA6    A3+         SET SEQUENCE NUMBER IN MB
          NZ     X4,RJS1     IF NOT REQUESTING QFT ENTRY
          SB6    RJS1        SET *MTRM* RETURN ADDRESS
          EQ     MTM0        REQUEST QFT ENTRY
 
 RJS1     SA1    JSNL        ADVANCE JOB SEQUENCE NUMBER
          MX0    -6
          SA7    A5          WRITE OR
          SA2    RJSA+3      FOURTH CHARACTER EXCLUSION MASK
          SB5    B0+
 RJS2     BX3    -X0*X1      GET CHARACTER
          BX4    X0*X1
          AX3    X3,B5
          SB6    X3+B1       INCREMENT TO NEXT CHARACTER
 RJS2.1   AX7    X2,B6
          LX7    -1
          PL     X7,RJS3     IF USABLE CHARACTER
          SB6    B6+B1       SKIP A CHARACTER
          NZ     X7,RJS2.1   IF NO OVERFLOW
          LX0    6
          SB6    1RA-1       RESET CHARACTER
          SX5    B5-18
 RJS2.2   SB6    B6+1
          AX7    X2,B6
          LX7    -1
          NG     X7,RJS2.2   IF EXCLUDED CHARACTER
          SX7    B6
          LX7    X7,B5
          BX1    X4+X7
          SB5    B5+6
          SA2    A2-B1       NEXT EXCLUSION MASK
          NZ     X5,RJS2     IF NOT END OF SEQUENCE NUMBER
          EQ     RJS4        WRITE NEXT SEQUENCE NUMBER
 
 RJS3     SX3    B6+
          LX3    X3,B5
          BX1    X3+X4
 RJS4     BX6    X1
          SA6    A1          WRITE NEXT SEQUENCE NUMBER
          EQ     PPRX        EXIT
 
 
*         DEFINE THE RANGE OF CHARACTERS ALLOWABLE IN EACH CHARACTER
*         POSITION IN JSN-S BY SETTING THE FIRST AND SECOND PARAMETERS
*         OF THE *JSNMASK* MACRO FOR THAT POSITION TO THE LOWEST AND
*         HIGHEST ALLOWABLE CHARACTERS FOR THAT POSITION.
*         THE FIRST PARAMETER MUST BE EQUAL TO OR HIGHER THAN *A*, AND
*         THE SECOND PARAMETER MUST BE EQUAL TO OR LOWER THAN *9*.
*         THE LOW AND HIGH DEFAULTS ARE *A* AND *9*, RESPECTIVELY.
*
*         TO EXCLUDE A CHARACTER FROM USE IN A PARTICULAR CHARACTER
*         POSITION IN JSN-S, ADD IT TO THE LIST IN THE THIRD PARAMETER
*         OF THE *JSNMASK* MACRO FOR THAT POSITION.  TO ALLOW A
*         CHARACTER TO BE USED, OMIT OR REMOVE IT FROM THE LIST.
*
*         NOTE - IF THE LETTER *A* IS TO BE EXCLUDED, IT WILL ALSO BE
*         NECESSARY TO CHANGE THE INITIAL JSN, WHICH CAN BE FOUND AT
*         LABEL *.JSN* IN THE DECK *SET*.
 
 
 RJSA     BSS    0           JSN CHARACTER EXCLUSION MASKS
          JSNMASK  A,9,(0,1,2,3,4,5,6,7,8,9) 1ST CHARACTER MASK (X---)
          JSNMASK  A,9,(0,1,2,3,4,5,6,7,8,9) 2ND CHARACTER MASK (-X--)
          JSNMASK  A,9,(0,1,2,3,4,5,6,7,8,9) 3RD CHARACTER MASK (--X-)
          JSNMASK  A,9,(0,1,2,3,4,5,6,7,8,9) 4TH CHARACTER MASK (---X)
 RLMM     SPACE  4,25
***       RLMM - REQUEST LIMIT.
*
*         ENTRY
*T,OR     12/   RLMM,12/ FN,18/0,18/VL
*
*              FN    SUBFUNCTION CODE.
*                    RLCO  CLEAR OVERFLOW FLAGS.
*                    RLIT  INCREMENT TIME LIMIT.
*                    RLIS  INCREMENT JOB STEP SRU LIMIT.
*                    RLJS  START JOB STEP.
*                    RLTL  SET TIME LIMIT
*                    RLSL  SET SRU LIMIT
*                    RLIA  INCREMENT ACCOUNT BLOCK SRU LIMIT.
*
*              VL    VALUE OF INCREMENT OR LIMIT REQUESTED
*         EXIT
*
*T,OR     52/  0,8/ OF   FOR SUBFUNCTION RLCO
*                  OF   OVERFLOW FLAGS IN SRUW BEFORE CLEARING.
*
*T,OR     48/  0,12/  EF   FOR SUBFUNCTIONS RLIT AND RLIS
*
*                  EF   ERROR FLAG (0 IF NO ERRORS)
*
*T,OR     60/  0   FOR SUBFUNCTION RLJS
 
 
          PPR    RLMM
 
          MX3    -18         GET VALUE REQUESTED
          SB3    PPR1        PRESET RETURN ADDRESS
          BX5    -X3*X1
          LX1    24          GET SUBFUNCTION NUMBER
          SB4    X1-TRLML
          MX0    -30
          PL     B4,HNG      IF ILLEGAL PROCESSOR
          JP     TRLM+TRLML+B4  JUMP TO PROCESSOR
 
 
**        EXIT TO PROCESSOR WITH -
*
*         (X0) = 30/-0,30/0
*         (X3) = 42/-0,18/0
*         (X5) = PARAMETER VALUE
*         (B3) = RETURN ADDRESS
 
*         SUBFUNCTION TABLE.
 
 TRLM     BSS    0
          LOC    0
 
+         SA2    B7+SRUW
          EQ     RLM1        (RLCO) - CLEAR OVERFLOW FLAGS
 
+         SA1    B7+CPLW
          EQ     RLM2        (RLIT) - INCREMENT TIME LIMIT
 
+         SA1    B7+STLW
          EQ     RLM3        (RLIS) - INCREMENT JOB STEP SRU LIMIT
 
+         SA2    B7+SRUW
          EQ     RLM8        (RLJS) - START JOB STEP
 
+         SA2    B7+CPJW     (RLTL) - SET TIME LIMIT
          EQ     RLM11
 
+         SA1    B7+SRJW     (RLSL) - SET SRU LIMIT
          EQ     RLM12
 
+         SA1    B7+STLW
          EQ     RLM16       (RLIA) - INCREMENT ACCOUNT BLOCK SRU LIMIT
 
 TRLML    BSS    0
          LOC    *O
 
*         RETURN AND CLEAR OVERFLOW FLAGS
 
 
 RLM1     MX3    -9
          LX2    19
          BX7    -X3*X2      ISOLATE FLAGS FOR CALLER
          BX6    X3*X2       CLEAR FLAGS
          LX6    41
          SA6    A2
          JP     PPR1        EXIT
 
*         INCREMENT TIME LIMIT.
 
 RLM2     BX6    X1
          SB4    RLM2.1      SET *MSB* RETURN ADDRESS
          SA2    CPTB        CONVERT QUARTER NANOUNITS TO MILLIUNITS
          EQ     /PROGRAM/MSB  MULTIPLY 60 BIT INTEGER
 
 RLM2.1   SX2    1000        CONVERT INCREMENT TO MILLISECONDS
          BX3    X6
          IX5    X2*X5
          SA4    B7+CPJW     GET ACCUMULATOR AT JOB STEP START
          SA1    B7+ALMW     GET VALIDATION LIMIT
          MX6    -6
          BX4    -X0*X4      JOB START
          LX6    30
          LX4    8           RESTORE FIELD SIZE
          IX3    X3+X5       REQUESTED NEW LIMIT
          BX1    -X6*X1
          BX6    X6+X1
          ZR     X6,STL      IF UNLIMITED VALIDATION
          LX1    -30+6+3     CONVERT AS COMCCVI BUT CONVERT TO SECONDS
          SX6    X1+KTLI*10B (X6) = VALIDATION LIMIT IN SECONDS
          IX6    X2*X6       CONVERT TO MILLISECONDS
          IX6    X6+X4       VALIDATION LIMIT
          IX1    X6-X3
          PL     X1,STL      IF VALIDATION .GE. REQUESTED
          SA1    A5-B1       CHECK FOR *1AJ* CALL
          BX7    X3          SAVE NEW LIMIT
          SA2    B7+EECW
          LX1    18
          BX3    X6          SET LIMIT TO VALIDATION LIMIT
          SX6    B1+
          LX6    48
          SX1    X1-3R1AJ
          NZ     X1,RLM2.2   IF NOT A *1AJ* CALL
          BX3    X7          SET LIMIT TO NEW LIMIT
          BX6    X6+X2       SET VALIDATION EXTENDED FLAG
          SA6    A2+
 RLM2.2   SA1    B7+SRUW     SET VALIDATION LIMIT FLAG
          MX2    1
          BX6    X1+X2
          SA6    A1
          EQ     STL         SET TIME LIMIT
 
*         INCREMENT JOB STEP SRU LIMIT.
 
 RLM3     MX2    -42         GET CURRENT COMPUTED LIMIT
          BX4    -X2*X1
 
*         CONVERT REQUESTED INCREMENT TO MICRO-UNITS*10.
 
          SX1    10000000/200B
          LX1    7
          IX3    X1*X5       REQUESTED INCREMENT (MICRO-UNITS*10)
          JP     RLM13
 
*         BEGIN JOB STEP.
 
 RLM8     MX4    -59         CLEAR TIME LIMIT VALIDATION FLAG
          BX6    -X4*X2
          SA1    B7+MP3W     ENSURE SRU ACCUMULATION ENABLED
          SA6    A2
          BX6    -X4*X1
          SA6    A1
          MX4    -42         ISOLATE SRU ACCUMULATOR
          BX4    -X4*X2
          SA1    B7+SRJW     SET SRU AT JOB STEP START
          BX2    X4
          AX2    12
          BX6    X0*X1       CLEAR OLD VALUE
          BX6    X2+X6       INSERT NEW ONE
          SA6    A1
          SB3    RLM9        SET RETURN ADDRESS
          LX1    30
          MX6    -3
          BX5    -X3*X1      JOB STEP LIMIT
          BX6    -X6+X5      ADD LOWER THREE BITS FOR CHECK
          BX1    X6+X3
          SX3    -B1         PRESET UNLIMITED JOB STEP LIMIT
          ZR     X1,RLM13    IF UNLIMITED JOB STEP LIMIT
          SX2    10000000/200B
          MX3    -18         RESTORE MASK
          LX2    7
          SA1    B7+STLW     GET ACCOUNT BLOCK LIMIT
          LX1    18
          BX1    -X3*X1
          IX3    X2*X5       JOB STEP LIMIT (MICRO-UNITS*10)
          IX6    X2*X1
          IX6    X6-X4       ACCOUNT BLOCK LIMIT - ACCUMULATOR
          IX5    X6-X3       REMAINING - NORMAL JOB STEP
          PL     X5,RLM13    IF ENOUGH IN ACCOUNT BLOCK FOR JOB STEP
          BX3    X6          USE REMAINING AS JOB STEP LIMIT
          PL     X6,RLM13    IF NOT OVER ACCOUNT BLOCK LIMIT
          R=     X3,TSLI     ALLOW USER TO RAISE LIMIT
          IX3    X3*X2       CONVERT TO MICRO-UNITS*10
          EQ     RLM13       SET SRU LIMIT
 
 RLM9     SA4    B7+CPTW     GET CP ACCUMULATOR
          BX6    X4
          SB4    RLM9.1      SET *MSB* RETURN ADDRESS
          SA2    CPTB        CONVERT QUARTER NANOUNITS TO MILLIUNITS
          EQ     /PROGRAM/MSB  MULTIPLY 60 BIT INTEGER
 
 RLM9.1   BX4    X6
          MX2    30
          SA1    B7+CPJW     SET TIME AT JOB STEP START
          AX6    8
          BX2    X2*X1
          BX6    X6+X2
          SA6    A1+
          MX3    -18         GET JOB STEP TIME LIMIT
          AX1    30
          BX5    -X3*X1
          BX1    X3-X5
          SB3    .RCPM       *STL* RETURN ADDRESS
          ZR     X1,STL      IF LIMIT INDEFINITE
 RLM10    SX2    1000        CONVERT LIMIT VALUE TO MILLISECONDS
          IX5    X2*X5
          IX3    X4+X5       NEW COMPUTED TIME LIMIT IN MILLISECONDS
          JP     STL         SET TIME LIMIT
 
*         SET TIME LIMIT.
 
 RLM11    LX2    30
          BX1    X3*X2       CLEAR OLD VALUE
          BX6    X1+X5       INSERT NEW LIMIT VALUE
          LX6    30
          SA6    A2
          BX1    X3-X5
          ZR     X1,STL      IF INDEFINITE
          BX4    -X0*X6
          LX4    8
          JP     RLM10
 
*         SET SRU LIMIT.
 
 RLM12    BX4    -X0*X1      SRU ACCUMULATOR AT JOB STEP START
          LX4    12          RESTORE 42 BIT VALUE
          LX1    30
          BX1    X3*X1       CLEAR OLD VALUE
          SX2    10000000/200B
          BX6    X1+X5       INSERT NEW VALUE
          BX1    X3-X5       CHECK FOR INDEFINITE REQUEST
          LX6    30
          SA6    A1+
          ZR     X1,RLM13    IF INDEFINITE
          LX2    7
          IX3    X2*X5       CONVERT TO MICRO-UNITS*10
 
*         SET SRU LIMIT, CLEAR LIMIT FLAGS.
*         (X3) = INCREMENT (MICRO-UNITS*10).
*         (X4) = ACCUMULATOR (MICRO-UNITS*10).
 
 RLM13    SA2    B7+FPFW     GET SRU VALIDATION LIMIT
          MX1    -12
          LX2    11-47
          BX2    -X1*X2
          SX0    B0+         CLEAR SRU VALIDATION LIMIT FLAG
          BX5    -X1-X2
          SX1    10000000/200B
          MX6    42
          LX1    7           MULTIPLY BY 200B
          LX6    -18         PRESET UNLIMITED SRU VALIDATION
          ZR     X5,RLM14    IF SRU VALIDATION UNLIMITED
          LX2    6           CONVERT VALIDATION TO SRU-S
          SX6    KSLI*10B-KSLI*10B/100B*100B  APPLY REST OF SRU FORMULA
          IX2    X6+X2       VALIDATION IN SRU-S
          IX6    X1*X2       CONVERT TO MICRO-UNITS*10
          IX2    X3+X4       ADD INCREMENT TO LIMIT
          IX1    X6-X2       VALIDATION LIMIT - REQUESTED LIMIT
          PL     X1,RLM14    IF WITHIN ALLOWED RANGE
          SA1    A5-B1       CHECK FOR *1AJ* CALL
          LX1    18
          SX1    X1-3R1AJ
          MX0    1           SET SRU VALIDATION LIMIT FLAG
          ZR     X1,RLM14    IF *1AJ* ALLOW FULL INCREMENT
          IX3    X6-X4       USE REMAINING VALIDATION AMOUNT
 RLM14    LX0    57-59
          SA1    B7+STLW     SET NEW JOB STEP SRU LIMIT
          MX2    18          USED FOR LOW ORDER 42-BIT FIELD
          BX2    X2*X1       CLEAR OLD VALUE
          PL     X3,RLM15    IF NOT INFINITE
          IX3    X6-X4       COMPUTE REMAINING VALIDATION AMOUNT
 RLM15    IX5    X3+X4       NEW SRU LIMIT
          BX6    X5+X2       INSERT NEW VALUE
          SA6    A1
          MX5    2
          SA1    B7+SRUW     CLEAR SRU LIMIT FLAG
          LX5    57-59
          BX6    -X5*X1
          BX6    X6+X0       CONDITIONAL SET SRU VALIDATION LIMIT FLAG
          SA6    A1
          JP     B3
 
*         INCREMENT ACCOUNT BLOCK SRU LIMIT.
 
 RLM16    MX2    18
          SX3    10000000/200B
          BX0    X2*X1       EXTRACT ACCOUNT BLOCK SRU LIMIT
          LX3    7
          BX4    -X2*X1      EXTRACT COMPUTED JOB STEP SRU LIMIT
          BX0    -X2+X0
          IX3    X3*X5       REQUESTED INCREMENT (MICRO-UNITS*10)
          ZR     X0,RLM13    IF ACCOUNT BLOCK SRU UNLIMITED
          LX5    -18
          IX6    X5+X1       ADD REQUESTED INCREMENT TO LIMIT
          SA6    A1          UPDATE ACCOUNT BLOCK SRU LIMIT
          EQ     RLM13       SET SRU LIMIT
 ROCM     SPACE  4,35
**        ROCM - ROLLOUT JOB.
*
*         ENTRY
*T, OR    12/ ROCM,1/C,11/ OP,12/ CPN,24/
*         C = 1, IF JOB AT CP/PCP *CPN* TO BE ROLLED.
*         C = 0, IF CP TO WHICH PP IS ASSIGNED TO BE ROLLED.  IF AN
*                ALTERNATE CP ASSIGNMENT IS IN EFFECT, THE ALTERNATE CP
*                WILL BE USED.  ROLLOUT OF A PCP MUST BE REQUESTED WITH
*                *C = 1* (ALTERNATE PCP ASSIGNMENT WILL NOT BE
*                PROCESSED WITH *C = 0*).
*         OP     BIT SELECTION(S) SPECIFYING OPTION(S) REQUESTED
*                (DEFINED IN *COMSCPS*).
*                *ROTE* = BIT 36 SET = TIMED/EVENT ROLLOUT FLAG TO
*                       BE SET IN *STSW*.
*                *RODS* = BIT 37 SET = DISABLE JOB FLAG TO BE SET
*                       IN *STSW*.
*                *ROSC* = BIT 38 SET = SCP ROLLOUT FLAG TO BE SET
*                       IN *STSW*.
*                *ROSU* = BIT 39 SET = SUSPEND JOB FLAG TO BE SET
*                       IN *STSW*.
*                *ROPR* = BIT 40 SET = ROLL JOB TO PSEUDO-CONTROL
*                       POINT IF POSSIBLE.
*         CPN    CP/PCP NUMBER OF JOB TO BE ROLLED IF *C* SELECTED.
*
*T, MB    24/,12/ T,12/ EQ,12/ EV
*         T      TIMED/EVENT ROLLOUT TIME.
*         EQ     TIMED/EVENT EST ORDINAL.
*         EV     TIMED/EVENT EVENT DESCRIPTOR.
*         MESSAGE BUFFER PARAMETERS ARE MEANINGFUL ONLY WHEN THE *ROTE*
*         OPTION IS SELECTED.
*
*         EXIT
*T, OR    12/  0,12/  ST,36/
*         ST = 0 IF FUNCTION ACCEPTED, OTHERWISE NON-ZERO.
*
*         HANG CONDITIONS -
*         INVALID CONNECTION STATUS IN EJT ENTRY.
*         SELECTED ROLLOUT OPTIONS ARE INVALID DUE TO THE JOB-S
*         CONNECTION STATUS.
 
 
          ERRNZ  ROSR        CHECK SCHEDULER ROLLOUT BIT
          ERRNZ  ROTE-1      CHECK TIMED/EVENT ROLLOUT BIT
          ERRNZ  RODS-2      CHECK DISABLE JOB BIT
          ERRNZ  ROSC-4      CHECK SCP ROLLOUT BIT
          ERRNZ  ROSU-10B    CHECK SUSPEND JOB BIT
          ERRNZ  ROPR-20B    CHECK PSEUDO-ROLL BIT
 
 
          PPR    ROCM
 
*         CHECK CP/PCP NUMBER SPECIFIED, DUAL CPU ACTIVITY, AND JOB
*         PRESENT AT CP/PCP.
 
          BX7    X1
          LX7    59-47
          PL     X7,ROC0.1   IF CP/PCP NOT SPECIFIED BY CALLER
          LX7    59-35-59+47
          AX7    48          SPECIFIED CP/PCP NUMBER
          LX7    7
          TB5    X7-200B,-SCA
          SB7    X7+         CP ADDRESS
          LT     B5,ROC0.1   IF CP SPECIFIED
          TB7    B5,PCPA     SET PCP ADDRESS
 ROC0.1   SA3    B7+TFSW     GET EJT ORDINAL
          BX7    X1          SET REJECT STATUS
          MX0    -12
          LX3    -48
          BX3    -X0*X3
          SB6    ROC0.2      SET *CPE* RETURN ADDRESS
          ZR     X3,PPR1     IF NO JOB PRESENT
          TNO    /DCP/CPE,DCP  IF DUAL CPU PRESENT
 
*         GET JOB STATE AND CONNECTION STATUS AND PROCESS TIMED/EVENT
*         PARAMETERS.
 
 ROC0.2   SB4    TROCL
          CX6    X3,EJT      CONVERT EJT ORDINAL INTO OFFSET
          TA3    X6+JSNE,EJT
          MX4    -11
          BX3    -X4*X3
          SA4    B7+TERW
          LX3    -7
          BX6    X4
          LX5    59-36
          SB6    X3+         CONNECTION STATUS
          MX1    30
          PL     X5,ROC1     IF NOT TIMED/EVENT ROLLOUT
          SA2    A5+1        GET TIMED/EVENT PARAMETERS
          BX4    X1*X4       CLEAR OLD TIMED/EVENT DATA
          MX6    -24
          BX6    -X6*X2      ISOLATE EST ORDINAL AND EVENT DESCRIPTOR
          AX2    24
          BX2    -X0*X2      ISOLATE TIME
          LX2    21
          BX6    X2+X6       MERGE TIME, EST ORDINAL AND EVENT
          BX6    X4+X6       MERGE TIMED/EVENT DATA INTO *TERW*
 
*         VALIDATE ROLLOUT OPTION FOR CURRENT CONNECTION STATUS.
 
 ROC1     SA2    B6+TROC
          SX1    EXJS*2
          LX5    59-47-59+36
          AX3    59-6
          BX4    X1-X3
          BX2    X2*X5
          SX1    PCJS*2
          BX3    X1-X3
          MX1    1
          NZ     X2,HNG      IF INVALID OPTION
          GE     B6,B4,HNG   IF INVALID CONNECTION STATUS
          PL     X5,ROC3     IF CP/PCP NOT SPECIFIED BY CALLER
 
*         CHECK FOR JOB CONDITIONS INHIBITING ROLLOUT IF CALLER
*         SPECIFIED CP/PCP.
 
          SB3    PPRX        SET *RPC* EXIT ADDRESS
          ZR     X4,ROC2     IF *EXJS* AND NOT ADVANCING/INTERLOCKED
          NZ     X3,PPR1     IF NOT *PCJS* OR ADVANCING/INTERLOCKED
 ROC2     SA3    CMCL        CHECK FOR MOVE IN PROGRESS
          BX2    X5
          LX3    -48
          LX2    -24-59+47
          BX4    X3-X2
          BX4    -X0*X4
          BX3    -X0*X2
          ZR     X4,PPR1     IF CP/PCP MOVING
          SA1    B7+JCIW     CHECK FOR ROLLOUT INHIBITED
          LX1    59-39
          NG     X1,PPR1     IF *CPUPFM* ACTIVE
          TB4    B7,-SCA
          SB4    -B4
          SX7    B0+
          SB6    B1          SET *RPC* ENTRY CONDITION
 
*         INITIATE ROLLOUT OF PCP.
 
 ROC3     TA1    STSW,SCA    CHECK FOR AVAILABLE RECALL SLOT
          PL     B4,ROC3.1   IF NOT PCP ROLL
          MX4    -4
          BX4    -X4*X1
          ZR     X4,PPR1     IF NO RECALL SLOTS AVAILABLE
 ROC3.1   SA6    A4          UPDATE *TERW*
          PL     B4,ROC4     IF NOT PCP ROLL
          SA7    A5          RELEASE CALLING PP
          SB4    B7          PCPA ADDRESS FOR *RPC*
          SB5    X3          PCP NUMBER
          TEQ    (/PCP/RPC,PCP,/MONITOR/HNG)  IF PCP ROLL
 
*         CPUCIO ENTRY FOR DETACHED INTERACTIVE I/O.
*         (B6) = -1.
*         (X5) = ROLLOUT CONTROL OPTIONS.
 
 ROC4     SA1    B7+STSW
          SX0    B1+         CLEAR EXISTING PSEUDO-ROLLOUT ALLOWED FLAG
          LX0    31-0
          BX1    -X0*X1
          MX0    3           EXTRACT CPU STATUS
          BX6    X1
          BX3    X0*X1
          AX6    24          EXTRACT CURRENT ROLLOUT STATUS
          MX0    -2
          BX0    -X0*X6
          MX2    5
          BX6    -X0
          NZ     X0,ROC5     IF ROLLOUT REQUESTED ALREADY SET
          MX6    -1
          ZR     X3,ROC5     IF NULL STATUS
          MX6    -2
 ROC5     LX6    24
          LX0    59-0
          BX6    -X6+X1
          BX0    X2*X0
          LX5    59-40-59+47
          BX2    X2*X5       GET ROLLOUT FLAGS
          MX4    -4
          BX2    -X0*X2      DISALLOW PSEUDO-ROLL IF MULTIPLE *ROCM*-S
          LX2    31-59
          BX6    X6+X2
          SA6    A1+
          LX1    -4
          BX3    -X4*X1      REQUESTS IN PQ, RQ, BQ, CQ PLUS TAPES
          LX1    -4
          BX0    -X4*X1      REQUESTS IN BQ AND CQ
          IX3    X3-X0       REQUESTS IN PQ, RQ, AND TAPE ACTIVITY
          ZR     X3,ROC11    IF NO REQUESTS IN PQ OR RQ
          MX0    -7
          SX3    RQRL
          MX4    -12
          SB4    B0
 
*         DELETE REQUESTS FROM RQ AND PQ.
 
 ROC6     ZR     X3,ROC10    IF END OF QUEUE
          SA2    X3          READ NEXT QUEUE ENTRY
          BX3    -X4*X2
 ROC7     BX5    X0*X3
          SB5    X5
          NE     B5,B7,ROC6  IF NOT THIS CP
          SA1    X3          READ NEXT ENTRY
          NZ     B4,ROC9     IF PROCESSING PQ
          LX1    12
          BX6    -X4*X1
          SX6    X6-PTRF
          LX1    -12
          ZR     X6,ROC6     IF ROLLOUT INHIBITED
          BX2    X4*X2       DELINK ENTRY FROM SYSTEM-WIDE QUEUE
          BX3    -X4*X1
 ROC8     BX6    X3+X2
          SA6    A2
          EQ     ROC7        CONTINUE
 
 ROC9     BX6    X4*X1
          NZ     X6,ROC6     IF PRIORITY PP REQUEST
          BX2    X4*X2       DELINK ENTRY FROM SYSTEM-WIDE QUEUE
          BX3    -X4*X1
          EQ     ROC8        COMPLETE PROCESS
 
 ROC10    SX3    PQRL
          SB4    B4+1
          EQ     B4,B1,ROC6  IF PQ NOT PROCESSED
 ROC11    SX5    B0          SET NO CLEAR OF ROLLOUT CPU STATUS
          NG     B6,.DCPM    IF *CPUCIO* REQUEST
          SB6    B1          SET TO CLEAR OUTPUT REGISTER
          EQ     .DCPM       DROP CPU
          SPACE  4,10
*         THE FOLLOWING TABLE CONTAINS AN ENTRY FOR EACH CONNECTION
*         STATUS.  EACH ENTRY INDICATES WHAT ROLLOUT CONTROL OPTIONS
*         ARE INVALID FOR JOBS HAVING THE CORRESPONDING CONNECTION
*         STATUS.  THE OPTION IS INVALID IF THE FLAG IS SET.
 
 TROC     BSS    0
 
          VFD    12/ROSU+RODS,48/0  CONNECTION STATUS = *NICS*
          VFD    12/RODS,48/0       CONNECTION STATUS = *DTCS*
          VFD    12/0,48/0          CONNECTION STATUS = *OLCS*
 
 TROCL    EQU    *-TROC      MAXIMUM CONNECTION STATUS + 1
          ERRNZ  TROCL-MXCS  ERROR IN TABLE DEFINITION
 RPNM     SPACE  4,30
***       RPNM - READ P REGISTER/BREAKPOINT.
*
*         READ P REGISTER.
*
*         ENTRY
*T, OR    12/ RPNM,30/,18/ 0
*
*         EXIT
*T, OR    12/ 0,12/ STAT,12/ CP,24/ P
*
*         STAT   BYTE 0 OF STSW OF THE ACTIVE JOB.
*         CP     CONTROL POINT NUMBER OF JOB CURRENTLY ACTIVE ON
*         CPU-0 (UNLESS ASSIGNED JOB IS ACTIVE).
*         P      PROGRAM ADDRESS OF ACTIVE JOB.
*
*         BREAKPOINT.
*
*         ENTRY
*T, OR    12/ RPNM,30/ 0,18/ BA
*
*         BA     BREAKPOINT ADDRESS.
*
*         EXIT
*T, OR    12/ 0,3/ ST,33/ 0,12/ RV
*
*         BA IS COMPARED TO THE PROGRAM COUNTER OF THE JOB TO
*         WHICH THE CALLING PP IS ASSIGNED.
*
*         ST = 0 IF COMPARISON FAILS.
*         ST = CPU STATUS FROM *STSW* IF COMPARISON SUCCEEDS.
*         RV = 1  IF COMPARISON FAILS.
*         RV = 0 IF COMPARISON SUCCEEDS.
 
 
          PPR    RPNM,,,DCP
 
          SA3    CPAL+A0     ACTIVE JOB
          SA2    B2          PROGRAM COUNTER OF ACTIVE XP
          AX3    24
          NZ     X1,RPN1     IF BREAKPOINT REQUEST
          SA1    X3+STSW     CONTROL POINT-S STATUS
          AX2    36          CURRENT PROGRAM COUNTER
          LX3    24          ACTIVE EXCHANGE PACKAGE
          BX2    X3+X2
          MX4    12
          BX1    X4*X1       EXTRACT CONTROL POINT STATUS
          LX1    -12
          BX7    X1+X2       FORM RESPONSE
          EQ     PPR1        RETURN
 
 RPN1     SB5    X3          CP ASSIGNED TO CPU-0
          EQ     B5,B7,RPN2  IF JOB IS EXECUTING
          SA2    B7          GET PROGRAM COUNTER FROM CP AREA
 RPN2     SA3    B7+STSW     CONTROL POINT STATUS
          AX2    36
          BX0    X2-X1       COMPARE PROGRAM COUNTER TO BA
          LX3    59-56
          SX7    B1          PRESET COMPARISON FAILED
          NG     X3,PPR1     IF SUBCONTROL POINT ACTIVE
          NZ     X0,PPR1     IF PROGRAM COUNTER DOES NOT MATCH BA
          EQ     .DCPM       DROP THE CPU
 RPPM     SPACE  4,30
***       RPPM - REQUEST PPU TO BE ASSIGNED.
*
*         ENTRY
*T, OR    12/  RPPM, 8/, 1/A, 1/S, 1/D, 1/P, 36/
*T, MB    60/  IR
*T, MB+1  1/Q,59/ PAR
*
*         IR     INPUT REGISTER OF PP, CONTROL POINT NEED NOT BE SET.
*         P      PP PRIORITY REQUEST.
*         D      IF SET, DROP PP.
*         S      IF SET, SPECIAL *1VP* REQUEST FOR PARTNER PP-S.
*                THIS REQUEST MUST ALSO BE A PRIORITY REQUEST.
*         A      IF SET, ASSIGN PP TO SYSTEM CONTROL POINT.
*         Q      RECALL FLAG, SET BY *CPUMTR* WHEN CALL IS QUEUED.
*         PAR    PARAMETER DATA TO BE PASSED TO ASSIGNED PP IN *MB*.
*
*         EXIT
*T, OR    12/  0, 12/  ST, 12/  ST2, 24/
*         ST = ADDRESS OF ASSIGNED PPU-S INPUT REGISTER.
*         ST = ADDRESS OF REQUEST IN RECALL STACK IF NOT ASSIGNED.
*         ST = 0 IF RECALL STACK FULL.
*         ST = 0  IF PRIORITY REQUEST AND NO PP AVAILABLE.
*         ST = 1 IF *CIO* REQUEST PROCESSED.
*         ST2 = ADDRESS OF SECOND ASSIGNED PP-S INPUT REGISTER, IF
*               PARTNER PAIR ASSIGNED FOR SPECIAL *1VP* REQUEST.
*
*         NOTE -
*         THE AUTO RECALL BIT IN THE CALLING PP-S INPUT
*         REGISTER IS PROPAGATED TO THE RECALLED REQUEST
*         AND THE AUTO RECALL BIT IS REMOVED FROM THE
*         CALLING PP-S INPUT REGISTER, IF THE DROP-PP
*         OPTION IS SET.
*
*         A REJECT STATUS WILL BE RETURNED ON A PRIORITY PP REQUEST
*         IF THERE IS CURRENTLY A PRIORITY REQUEST IN THE QUEUE.
*         THIS LIMITS THE NUMBER OF PRIORITY REQUESTS IN THE QUEUE
*         TO ONE, WHICH WILL ALWAYS BE AT THE TOP, AND WILL BE THE
*         NEXT ENTRY TO BE PROCESSED WHEN A PP BECOMES AVAILABLE.
*         THE PRIORITY PP REQUEST OPTION IS MEANT TO BE USED
*         ONLY BY PP-S THAT REQUIRE KNOWLEDGE OF THE PP TO WHICH
*         ITS REQUEST WAS ASSIGNED (SUCH AS *DSD*, *1MT*, ETC.).
*         USAGE OF THIS OPTION FOR OTHER PURPOSES WILL SERIOUSLY
*         IMPACT PERFORMANCE, AND MAY CAUSE SYSTEM DEADLOCK.
*
*         * PP HUNG.* WILL OCCUR IF MB = 0.
 
 
          PPR    RPPM
 
 
*         NOTE - THIS SWITCH LOGIC IS ALSO USED IN THE *DCP* BLOCK.
 
          LX5    59-39
          TX4    A5-1,-SP
          PL     X5,RPP0.1   IF NOT FORCED CP ASSIGNMENT
          TB7    SCA         SET SYSTEM CONTROL POINT
 RPP0.1   ZR     X4,RPP1     IF PSEUDO PP CALL
          TB4    B7,-SCA
          ZR     B4,RPP1     IF REQUEST FOR SYSTEM CONTROL POINT
          SB4    A0-CPAL-1
          SA4    -B4
          AX4    24
          SB4    X4+
          NE     B4,B7,RPP1  IF NO CPU SWITCH REQUIRED
          TNO    /DCP/SAX,DCP
 RPP1     SA4    A5+B1       READ REQUEST
          LX1    59-36
          SB3    RPP7        *APQ* *ACQ* RETURN ADDRESS
          ZR     X4,HNG      IF PP CALL ZERO
          SB4    B0+         PRESET REQUEST TO BE QUEUED
          PL     X1,RPP2     IF NOT PRIORITY PP REQUEST
          SB4    -1          PRESET NO QUEUEING
 RPP2     LX1    36-37
          PL     X1,RPP4     IF NO DROP PP
          SX7    B1
          SB3    .DPPM       *APQ* *ACQ* RETURN ADDRESS
          SA1    A5-B1       READ INPUT REGISTER
          LX7    41
          BX5    X7*X1       PROPAGATE AUTO RECALL STATUS
          BX4    X4+X5
          BX6    -X7*X1      CLEAR AUTO RECALL BIT FROM *IR*
          SA6    A1
 RPP4     SA1    B7+STSW     FETCH CP STATUS WORD
          MX0    -4
          BX6    X4
          LX1    -4
          LX4    18
          BX2    -X0*X1      RECALL COUNT
          LX1    4-48
          BX3    -X0*X1      PP COUNT
          LX1    48-60+59-24
          NZ     X7,RPP5     IF DROP OPTION
          TB5    B7,-SCA
          SX0    X2-NPPCP-1
          ZR     B5,RPP5     IF SYSTEM CONTROL POINT
          NO
          IX0    X0+X3
 RPP5     PL     X0,PPR1     IF LIMIT OF PP-S
          NG     X1,RPP10    IF ROLLOUT REQUESTED
 RPP6     SX3    X4-3RCIO
          ZR     X3,RPP8     IF *CIO* REQUEST
          SA3    A5+2        MB+1 TO MB
          BX7    X3
          SA7    APQA
          SX3    X4-3R1VP
          NZ     X3,APQ      IF NOT *1VP* REQUEST
          SA2    A5          CHECK FOR SPECIAL REQUEST
          LX2    59-38
          TNG    X2,(/NVE/AVP,NVE,/MONITOR/HNG)  IF SPECIAL REQUEST
          EQ     APQ         ASSIGN PP
 
 RPP7     ZR     X1,RPP9     IF NO PP ASSIGNED AND PRIORITY REQUEST
          BX7    X1          RETURN ASSIGNMENT ADDRESS
          LX7    36
          SA7    A5          STORE *OR*
          EQ     MTRX        RETURN
 
 RPP8     SA4    A5+2        SET MESSAGE BUFFER
          SA6    /CPUCIO/IR  SET IR
          BX7    X4
          SA7    A6+B1       CLEAR MB
          ERRNZ  /CPUCIO/MB-/CPUCIO/IR-1
          EQ     /CPUCIO/CPC  PROCESS *CIO* REQUEST
 
 RPP9     BX7    X7-X7
          NG     X1,PPR1     IF REJECT ON STORAGE MOVE
          MX0    -18         CHECK FOR PRIORITY REQUEST PENDING
          SA2    PQRL
          SA2    X2
          AX2    18
          BX2    -X0*X2
          NZ     X2,PPR1     IF REQUEST ALREADY PENDING
          SB3    MTRX        *AQR* RETURN ADDRESS
          SX2    PRP
 
*         NOTE - PARAMETER WORD IS NOT SAVED IN *REPW*.
 
          EQ     AQR         ASSIGN QUEUE REQUEST
 
*         PUT REQUEST IN CONTROL POINT AREA IF ROLLOUT SET.
 
 RPP10    TX3    A5-1,-SP
          ZR     X3,RPP6     IF PSEUDO-PP REQUESTING
          SX3    X4-3R1AJ
          ZR     X3,RPP6     IF *1AJ*
          NG     B4,RPP9     IF PRIORITY PP REQUEST
          LX1    24-59
          MX0    -4
          BX4    -X0*X1      NEXT FREE RECALL SLOT
          SB4    B7+RCCW-1
          BX7    X0*X1
          SA3    B4+X4       READ NEXT FREE RECALL SLOT
          SA6    A3+RECW-RCCW  STORE REQUEST TO RECALL
          SA4    A5+2        GET MB+1
          SX3    X3+20B
          MX6    1
          IX7    X7+X3
          BX6    X6+X4       SET RECALL FLAG
          SA7    A1          UPDATE STSW
          SA6    A3+REPW-RCCW  STORE PARAMETER WORD
          SX1    A3          SET ASSIGNMENT ADDRESS
          JP     B3          COMPLETE PROCESSING
 RSJM     SPACE  4
***       RSJM - REQUEST JOB SCHEDULER.
*
*         ENTRY
*T, OR    12/ RSJM, 12/,10/,1/R,1/F,12/,12/
*         R      IF SET, RESET THE RECALL CYCLE.
*         F      IF SET, QFT/EJT SCHEDULING SHOULD BE PERFORMED.
*
*         EXIT
*T, OR    60/  0
 
 
          PPR    RSJM
 
*         SET QFT/EJT SCHEDULING FLAG IN SCHEDULER CALL IF SET IN
*         *RSJM* REQUEST.
 
          SA7    A5          CLEAR OUTPUT REGISTER
          SX0    B1
          SA1    SJSA
          LX0    24-0
          BX6    X0*X5
          BX6    X6+X1
          SA6    A1
          LX0    25-24
          BX6    -X5*X0      ISOLATE FORCED RESET FLAG
          NZ     X6,SJS      IF FORCED RESET NOT SPECIFIED
          ERRNZ  SJSB-SJSA-1 CODE ASSUMES *SJSB* = *SJSA* + 1
          SA6    A6+B1
          EQ     SJS
 RTCM     SPACE  4,105
***       RTCM - REQUEST TRACK CHAIN.
*
*         ENTRY
*T, OR    12/RTCM, 1/C, 2/, 9/ EQ, 12/ TK, 1/ A, 2/, 3/ AL, 18/ SC
*         C      SET CHECKPOINT UPON FUNCTION COMPLETION.
*         EQ     EST ORDINAL.
*                IF EQ IS ZERO TK BYTE CONTAINS SELECTION PARAMETER.
*         TK     CURRENT TRACK IF EQ IS NON-ZERO
*         TK     DEVICE SELECTION PARAMETER AS FOLLOWS. (EQ IS ZERO)
*                0 = TMPS = SELECT TEMP DEVICE.
*                1 = INPS = SELECT INPUT FILE DEVICE.
*                2 = OUTS = SELECT OUTPUT FILE DEVICE.
*                3 = ROLS = SELECT ROLLOUT DEVICE.
*                4 = DAYS = SELECT USER DAYFILE DEVICE.
*                5 = PRIS = SELECT PRIMARY FILE DEVICE.
*                6 = LOCS = SELECT LOCAL FILE DEVICE.
*                7 = LGOS = SELECT LGO FILE DEVICE.
*               10 = SROS = SECONDARY ROLLOUT FILE DEVICE.
*               11 = R1OS = RESERVED FOR CDC.
*               12 = R2OS = RESERVED FOR CDC.
*               13 = TNDS = TEMPORARY NON-SHARED FILE DEVICE.
*         A      ACCESS LEVEL SELECTION SPECIFIED.
*         AL     ACCESS LEVEL.
*         SC     SECTOR COUNT.
*                -1 IF ALL SECTORS ON DEVICE REQUESTED.
*                 0 IF REQUESTING 1 TRACK.
*
*         A DEVICE ELIGIBLE FOR SELECTION MUST BE *ON*, HAVE ENOUGH
*         SPACE TO SATISFY THE REQUEST, MUST NOT HAVE ERROR IDLE SET,
*         AND, IF ACCESS LEVEL SELECTION IS SPECIFIED, MUST HAVE
*         THE REQUESTED ACCESS LEVEL WITHIN THE DEVICE ACCESS LEVEL
*         RANGE.  THE ALGORITHM SEARCHES FOR AN ELIGIBLE DEVICE
*         STARTING WITH THE NEXT EQUIPMENT AFTER THE LAST ELIGIBLE
*         DEVICE.  THE PRESENCE OF A COPY OF THE SYSTEM ON A DEVICE
*         IS CONSIDERED AS ADDITIONAL ACTIVITY IN THOSE DECISIONS
*         MADE BASED ON ACTIVITY.  THIS IS DONE SUCH THAT A DEVICE
*         WITHOUT A COPY OF THE SYSTEM WILL USUALLY BE GIVEN PREFERENCE
*         OVER A DEVICE WITH THE SYSTEM PROVIDING ACTIVITY IS EQUAL.
*         HOWEVER, NON-SYSTEM DEVICES HAVE NO PREFERENCE OVER
*         SYSTEM DEVICES IN COMPARING ACTIVITIES OF ZERO.
*
*         THE SELECTION ALGORITHM IS AS FOLLOWS.
*
*         1)     SELECT ELIGIBLE DEVICE WITH .GT. 1/8 OF SPACE LEFT
*                AND NO ACTIVITY SET.
*         2)     SELECT ELIGIBLE DEVICE WITH .GT. 1/8 OF SPACE LEFT.
*                IF *ROLS* OR *SROS* DEVICE SELECTION, SELECT DEVICE
*                WITH .GT. 1/8 OF SPACE LEFT AND LEAST ACTIVITY.
*         3)     SELECT BEST ELIGIBLE DEVICE OF ALLOCATION TYPE.
*         4)     IF SELECTION TYPE IS *TMPS*, REJECT REQUEST AND  EXIT.
*                IF SELECTION TYPE IS NOT *SROS*, SET SELECTION TYPE
*                *TMPS* AND RETURN TO STEP 1.  IF SELECTION TYPE IS
*                *SROS*, SET SELECTION TYPE *ROLS* AND RETURN TO STEP
*                1.
*
*         EXIT
*T, OR    12/  0, 12/  EQ, 12/  TKE, 12/  SCE, 12/  TKF
*
*         EQ     EST ORDINAL ASSIGNED.
*                ( = 4000 IF NO EQUIPMENT ASSIGNED).
*         TKE    TRACK NUMBER OF EOI SECTOR.
*         SCE    SECTOR NUMBER OF EOI SECTOR.
*                (REJECT REASON CODE IF NO TRACKS ALLOCATED).
*                ( = 1 IF REJECT BECAUSE OF TRACK LIMIT).
*                ( = 2 IF REJECT BECAUSE OF ACCESS LEVEL CONFLICT).
*         TKF    FIRST TRACK ASSIGNED.
*                ( = 0 IF NO TRACKS ALLOCATED).
*         BITS 59 AND 57 OF OR WILL BE SET ALONG WITH THE SELECTED
*         EST ORDINAL IF MONITOR SELECTED AN INDEPENDENT
*         SHARED DEVICE.
*
*         *PP HUNG.* WILL OCCUR FOR THE FOLLOWING CONDITIONS.
*         1)     EQUIPMENT NOT MASS STORAGE OR OUT OF EST.
*         2)     ECS ADDRESS OF MST SET WHEN NOT MULTI-MAINFRAME MODE.
*         3)     IF CURRENT TRACK IS NOT RESERVED OR IS LINKED.
*         4)     IF DEVICE SELECTION PARAMETER IS OUT OF RANGE.
*
*         NOTE - IF THE REQUEST IS FOR AN INDEPENDENT SHARED DEVICE,
*         THE MST, TRT, AND DIT ARE READ FROM THE DEVICE TO CM BY *1RU*
*         BEFORE THE RTCM IS ISSUED TO CPUMTR.
 
 
          PPR    RTCM,(/ISD/CHR,ISD,/LSPMMF/CME,LSPMMF,/MONITOR/PMR),RTC
,,FEX
 SCDM     SPACE  4,10
**        SCDM - SEARCH CENTRAL DIRECTORY.
*
*         ENTRY
*T,OR     12/ SCDM, 48/ 0
*T,MB     42/ EPN, 18/ 0
*         EPN    ENTRY POINT NAME.
*
*         EXIT
*T,OR     42/ 0, 18/ADDR
*T,MB     42/ EPN, 18/ 0
*         ADDR   ADDRESS OF PST ENTRY.
*         EPN    ENTRY POINT NAME.
 
 
          PPR    SCDM,,,FEX
 
          SA2    A5+1        GET ENTRY POINT NAME
          SB6    PPR1        SET *SCD* RETURN ADDRESS
          EQ     SCD         SEARCH CENTRAL DIRECTORY
 SCSM     SPACE  4,45
***       SCSM - SET CHANNEL STATE.
*
*         ENTRY
*T, OR    12/  SCSM,12/  EQ,12/  CH1,12/  SF,12/  CH2
*
*         EQ     EST ORDINAL.
*         CH1    CHANNEL 1 DATA.
*                FOR SUBFUNCTIONS *UPSS*, *DWSS*, *SUCS*, *SICS*,
*                 *DAPS* AND *EAPS* -
*                    CHANNEL NUMBER (INCLUDING CONCURRENCY FLAG).
*                FOR SUBFUNCTION *SCHS* -
*                    DATA TO BE STORED IN CHANNEL 1 FIELD.
*                FOR SUBFUNCTION *RVCS* -
*                    UNUSED.
*         SF     SUBFUNCTION.
*                UPSS = 0 = REINSTATE CHANNEL.
*                DWSS = 1 = REMOVE CHANNEL FROM SYSTEM USE.
*                SCHS = 2 = SET CHANNEL DATA.
*                SUCS = 3 = SET *UP* CHANNEL STATE.
*                SICS = 4 = SET *IDLE* CHANNEL STATE.
*                RVCS = 5 = REVERSE CHANNELS IN MST.
*                DAPS = 6 = DISABLE ACCESS PATH.
*                EAPS = 7 = ENABLE ACCESS PATH.
*         CH2    CHANNEL 2 DATA.
*                FOR SUBFUNCTION *SCHS* -
*                    DATA TO BE STORED IN CHANNEL 2 FIELD.
*                FOR SUBFUNCTIONS *UPSS*, *DWSS*, *SUCS*, *SICS*,
*                  *RVCS*, *DAPS* AND *EAPS* -
*                    UNUSED.
*
*         EXIT
*T, OR    12/  0,12/  ST,36/
*
*         ST     REPLY STATUS.
*
*                FOR SUBFUNCTION *UPSS* -
*                    EQ      IF REQUEST HONORED.
*                    0       IF REQUEST REJECTED DUE TO NO PP AVAILABLE
*                            FOR BUFFERED DRIVER OR *1MV*.
*
*                FOR SUBFUNCTION *DWSS* -
*                    EQ      IF REQUEST HONORED.  4000 BIT SET IF
*                            CHANNEL IS GLOBALLY DOWN.
*                    0       IF REQUEST REJECTED DUE TO *1MV* ACTIVE ON
*                            DEVICE OR CHANNEL SPECIFIC REQUESTS
*                            PRESENT.
*
*                FOR SUBFUNCTIONS *SCHS*, *SUCS*, *SICS*, *RVCS* AND
*                  *EAPS* -
*                    EQ      THERE ARE NO REJECT CONDITIONS FOR THESE
*                            SUBFUNCTIONS.
*
*                FOR SUBFUNCTION *DAPS* -
*                    EQ      IF REQUEST HONORED.
*                    0       IF REQUEST REJECTED DUE TO NO ALTERNATE
*                            PATH TO NON-DOWN DEVICE.
*
*         *PP HUNG* WILL OCCUR FOR THE FOLLOWING CONDITIONS -
*
*         1.  UNDEFINED SUBFUNCTION.
*         2.  INVALID EST ORDINAL.
*         3.  NON-MASS STORAGE EST ORDINAL SPECIFIED FOR ANY
*             SUBFUNCTION OTHER THAN *UPSS*, *DWSS*, *SCHS* OR *SUCS*.
*         4.  CHANNEL NOT DEFINED FOR SPECIFIED DEVICE FOR ANY
*             SUBFUNCTION OTHER THAN *SCHS* OR *RVCS*.
 
 
          PPR    SCSM
 
          BX7    X1
          LX1    -12
          MX0    -12
          BX2    -X0*X1      SUBFUNCTION
          SB4    X2-TSCSL
          PL     B4,HNG      IF INVALID SUBFUNCTION
          SB6    X2
          LX1    -12
          BX2    -X0*X1      CHANNEL NUMBER (CHANNEL 1 DATA)
          LX1    -12
          TB5    ESTL
          BX1    -X0*X1
          SB3    X1          EST ORDINAL
          GE     B3,B5,HNG   IF EST ORDINAL TOO LARGE
          SB5    B3-NOPE
          SB4    B6-SCHS
          CX3    X1,EST      CONVERT EST ORDINAL TO OFFSET
          MX6    -6
          TA3    X3+EQDE,EST
          BX5    -X0*X3
          LX5    3           MST ENTRY ADDRESS
          EQ     B4,B0,SCS4  IF SUBFUNCTION *SCHS*
          PL     B5,SCS0     IF EST ORDINAL IN RANGE
          NZ     B3,HNG      IF NOT EST ORDINAL ZERO
          BX4    X3
          MX1    -12
          LX4    -12
          BX4    -X1*X4      DEVICE MNEMONIC
          SB5    B6-RVCS
          SB4    X4-2RRD
          ZR     B4,HNG      IF *RD* PSEUDO-EQUIPMENT
          EQ     SCS1        CONTINUE
 
 SCS0     SB4    B6-SUCS
          SB5    B6-RVCS
          LE     B4,B0,SCS1  IF DEVICE MAY BE NON-MASS STORAGE
          ERRNZ  DWSS-UPSS-1 CODE DEPENDS ON VALUE
          ERRNZ  SCHS-DWSS-1 CODE DEPENDS ON VALUE
          ERRNZ  SUCS-SCHS-1 CODE DEPENDS ON VALUE
          PL     X3,HNG      IF NOT MASS STORAGE DEVICE
 SCS1     ZR     B5,SCS3     IF CHANNEL NOT SPECIFIED
          LX3    -24
          BX1    -X0*X3
          SB5    24          SET CHANNEL BYTE SHIFT COUNT
          ZR     X1,SCS2     IF CHANNEL 2 NOT PRESENT
          BX4    X2-X1
          BX4    -X6*X4
          ZR     X4,SCS3     IF CHANNEL 2 MATCHES SPECIFIED CHANNEL
 SCS2     LX3    -12
          BX4    X2-X3
          SB5    36          ADJUST CHANNEL BYTE SHIFT COUNT
          BX4    -X6*X4
          NZ     X4,HNG      IF CHANNEL 1 DOESN-T MATCH
 SCS3     SX1    3000B       CHANNEL STATE MASK
          LX1    B5          POSITION CHANNEL STATE MASK
          SA3    A3          REREAD EST ENTRY WORD *EQDE*
          BX1    X1*X3       CHANNEL STATE
          SB4    48+1
          SB4    B4-B5
 SCS4     JP     TSCS+B6     ENTER SUBFUNCTION PROCESSOR
 
*         ENTER PROCESSOR WITH -
*
*         (A3) = ADDRESS OF EST ENTRY WORD *EQDE*.
*         (A5) = PP OUTPUT REGISTER ADDRESS.
*         (B4) = 48+1-B5.
*         (B5) = CHANNEL BYTE SHIFT COUNT.
*         (B6) = SUBFUNCTION.
*         (X0) = MASK OF -12.
*         (X1) = CHANNEL STATE POSITIONED AS IN EST ENTRY.
*         (X2) = CHANNEL NUMBER (CHANNEL 1 DATA).
*         (X3) = EST ENTRY WORD *EQDE*.
*         (X5) = MST ENTRY ADDRESS (IF MASS STORAGE).
*         (X6) = MASK OF -6.
*         (X7) = PP OUTPUT REGISTER WITH BYTE 0 CLEAR.
 
 TSCS     BSS    0
 
          BSS    0           FORCE UPPER
 UPSS     EQU    *-TSCS
 UPSS     EQU    //UPSS      ENSURE SUBFUNCTION CORRECT
          SB6    SCS11       *SCH* EXIT ADDRESS
          EQ     SCS10       REINSTATE CHANNEL
 
          BSS    0           FORCE UPPER
 DWSS     EQU    *-TSCS
 DWSS     EQU    //DWSS      ENSURE SUBFUNCTION CORRECT
          SA4    X5+STLL
          EQ     SCS20       REMOVE CHANNEL FROM SYSTEM USE
 
          BSS    0           FORCE UPPER
 SCHS     EQU    *-TSCS
 SCHS     EQU    //SCHS      ENSURE SUBFUNCTION CORRECT
          SA4    A5
          BX4    -X0*X4      CHANNEL 2 DATA
          EQ     SCS30       SET CHANNEL DATA
 
          BSS    0           FORCE UPPER
 SUCS     EQU    *-TSCS
 SUCS     EQU    //SUCS      ENSURE SUBFUNCTION CORRECT
          SB6    PPR1        *SCH* EXIT ADDRESS
          EQ     SCS40       SET *UP* CHANNEL STATE
 
          BSS    0           FORCE UPPER
 SICS     EQU    *-TSCS
 SICS     EQU    //SICS      ENSURE SUBFUNCTION CORRECT
          SB6    PPR1        *SCH* EXIT ADDRESS
          EQ     SCS50       SET *IDLE* CHANNEL STATE
 
          BSS    0           FORCE UPPER
 RVCS     EQU    *-TSCS
 RVCS     EQU    //RVCS      ENSURE SUBFUNCTION CORRECT
          SA1    X5+DALL
          EQ     SCS60       REVERSE CHANNELS IN MST
 
          BSS    0           FORCE UPPER
 DAPS     EQU    *-TSCS
 DAPS     EQU    //DAPS      ENSURE SUBFUNCTION CORRECT
          SX1    B0
          EQ     SCS70       DISABLE ACCESS PATH
 
          BSS    0           FORCE UPPER
 EAPS     EQU    *-TSCS
 EAPS     EQU    //EAPS      ENSURE SUBFUNCTION CORRECT
          SX1    4000B
          EQ     SCS80       ENABLE ACCESS PATH
 
          BSS    0           FORCE UPPER
 TSCSL    EQU    *-TSCS
 
 
*         SUBFUNCTION *UPSS* - REINSTATE CHANNEL.
 
 SCS10    LX1    B4
          PL     X1,PPR1     IF CHANNEL NOT DOWN ON DEVICE
          SX6    B1
          EQ     SCH         SET *IDLE* CHANNEL STATE
 
 SCS11    SB6    PPR1        *RCB* EXIT ADDRESS
          EQ     RCB         RECONSTRUCT CHANNEL ACCESS BYTE IN MST
 
 
*         SUBFUNCTION *DWSS* - REMOVE CHANNEL FROM SYSTEM USE.
 
 SCS20    LX1    B4
          NG     X1,SCS26    IF CHANNEL STATE IS DOWN
          LX4    59-43
          PL     X3,SCS24    IF NOT MASS STORAGE
          PL     X4,SCS22    IF *1MV* NOT ACTIVE ON DEVICE
 SCS21    SX7    B0          SET REJECT STATUS
          EQ     PPR1        EXIT
 
 SCS22    SA1    X5+DILL
          LX1    -24
          BX1    -X0*X1      *PUT* ORDINAL
          MX6    -6
          LX1    PUTLS
          ZR     X1,SCS24    IF NON-BUFFERED DEVICE
          TA4    X1+UNCT,PUT
 SCS23    BX1    -X0*X4      NEXT CBT ORDINAL
          ZR     X1,SCS24    IF END OF SCAN
          LX1    CBTLS
          TA4    X1+IOLK,CBT
          SA1    A4-IOLK+HSLK
          LX4    -24
          LX1    59-58
          PL     X1,SCS23    IF NOT CHANNEL SPECIFIC REQUEST
          SA1    A4-IOLK+PAD4
          LX1    -54
          BX1    X2-X1
          BX1    -X6*X1
          ZR     X1,SCS21    IF REQUEST IS FOR IDLED CHANNEL
          EQ     SCS23       CHECK NEXT QUEUE ENTRY
 
 SCS24    SB6    SCS25       *SCH* RETURN ADDRESS
          SX6    3
          EQ     SCH         SET *DOWN* CHANNEL STATE
 
 SCS25    SB6    SCS26       *RCB* RETURN ADDRESS
          EQ     RCB         RECONSTRUCT MST CHANNEL ACCESS BYTE
 
 SCS26    TX1    ESTL
          SX3    NOPE-1
 SCS27    SX3    X3+B1       INCREMENT EST ORDINAL
          BX4    X3-X1
          NZ     X4,SCS28    IF NOT END OF SCAN
          SX1    B1+         SET GLOBAL DOWN STATUS
          LX1    47-0
          BX7    X7+X1
          EQ     PPR1        EXIT
 
 SCS28    CX4    X3,EST      CONVERT EST ORDINAL TO OFFSET
          MX6    -6
          TA4    EQDE+X4,EST
          PL     X4,SCS27    IF NOT MASS STORAGE
          LX4    59-47
          LX5    X4,B1
          PL     X4,SCS29    IF CHANNEL 1 NOT PRESENT AND ENABLED
          NG     X5,SCS29    IF CHANNEL 1 DOWN
          LX4    -48
          BX4    X4-X2
          BX4    -X6*X4
          ZR     X4,PPR1     IF CHANNEL IN USE ON DEVICE
 SCS29    LX5    59-35-59+47-1
          LX4    X5,B1
          PL     X5,SCS27    IF CHANNEL 2 NOT PRESENT AND ENABLED
          NG     X4,SCS27    IF CHANNEL 2 DOWN
          LX5    -48
          BX5    X5-X2
          BX5    -X6*X5
          ZR     X5,PPR1     IF CHANNEL IN USE ON DEVICE
          EQ     SCS27       CHECK NEXT EST ENTRY
 
 
*         SUBFUNCTION *SCHS* - SET CHANNEL DATA.
 
 SCS30    MX1    -24
          LX1    24
          BX6    X1*X3       CLEAR CHANNEL FIELDS
          LX2    12          POSITION CHANNEL 1 DATA
          BX2    X4+X2       MERGE WITH CHANNEL 2 DATA
          LX2    24
          BX6    X2+X6       MERGE NEW CHANNEL DATA
          SA6    A3          UPDATE EST ENTRY
          SB6    PPR1        SET *RCB* EXIT ADDRESS
          SA3    A3+         REREAD EST ENTRY
          EQ     RCB         RECONSTRUCT MST CHANNEL ACCESS BYTE
 
 
*         SUBFUNCTION *SUCS* - SET *UP* CHANNEL STATE.
 
 SCS40    SX6    B0+
          EQ     SCH         SET *UP* CHANNEL STATE
 
 
*         SUBFUNCTION *SICS* - SET *IDLE* CHANNEL STATE.
 
 SCS50    NZ     X1,PPR1     IF CHANNEL NOT UP
          SX6    B1+
          EQ     SCH         SET *IDLE* CHANNEL STATE
 
 
*         SUBFUNCTION *RVCS* - REVERSE CHANNELS IN MST.
 
 SCS60    BX4    -X0*X1
          BX1    X0*X1
          BX6    X4
          AX4    6
          LX6    6
          BX4    X4+X6
          BX4    -X0*X4
          BX6    X4+X1
          SA6    A1
          EQ     PPR1        EXIT
 
 
*         SUBFUNCTIONS *DAPS* - DISABLE ACCESS PATH.
 
 SCS70    SB4    B5-12
          LX4    X3,B4
          PL     X4,SCS21    IF NO ALTERNATE ACCESS
          LX4    1
          NG     X4,SCS21    IF ALTERNATE ACCESS IS DOWN
 
 
*         SUBFUNCTIONS *EAPS* - ENABLE ACCESS PATH.
 
 SCS80    SX6    4000B
          LX6    B5
          BX6    -X6*X3      CLEAR ENABLED BIT
          LX1    B5
          BX6    X1+X6       SET ENABLED FLAG IF SUBFUNCTION *EAPS*
          SA6    A3+         UPDATE EST ENTRY
          EQ     PPR1        EXIT
 RCB      SPACE  4,10
**        RCB - RECONSTRUCT CHANNEL ACCESS BYTE IN MST.
*
*         ENTRY  (A3) = EST ENTRY ADDRESS.
*                (B6) = RETURN ADDRESS.
*                (X0) = MASK OF -12.
*                (X3) = *EQDE* WORD OF EST ENTRY.
*                (X5) = MST ENTRY ADDRESS.
*
*         USES   X - 0, 1, 2, 3, 4, 6.
*                A - 2, 3, 6.
*                B - 3, 5.
 
 
 RCB      SB5    X2
          TB3    EST
          SB3    A3-B3
          NG     X3,RCB0     IF MASS STORAGE
          NE     B3,B0,RCB5  IF NOT *RD* DEVICE
          ERRNZ  RDEQ        CODE DEPENDS ON VALUE
 RCB0     MX6    60
          LX3    59-47
          MX1    60
          LX4    X3,B1
          PL     X3,RCB1     IF CHANNEL 1 NOT PRESENT AND ENABLED
          NG     X4,RCB1     IF CHANNEL 1 DOWN
          LX3    59-41-59+47
          NG     X3,RCB1     IF CHANNEL 1 IS CONCURRENT
          AX3    54          CHANNEL 1
          SX6    X3+
 RCB1     LX4    59-35-59+47-1
          LX3    X4,B1
          PL     X4,RCB2     IF CHANNEL 2 NOT PRESENT AND ENABLED
          NG     X3,RCB2     IF CHANNEL 2 DOWN
          LX4    59-29-59+35
          AX4    54          CHANNEL 2
          NG     X4,RCB2     IF CHANNEL 2 IS CONCURRENT
          SX1    X4+
 RCB2     BX3    X1
          SA2    X5+DALL
          LX3    6
          BX4    X3+X6
          PL     X4,RCB4     IF BOTH CHANNELS AVAILABLE
          BX4    X1*X6
          PL     X4,RCB3     IF SINGLE CHANNEL PRESENT
          SX4    B0+
 RCB3     SX3    X4+
          LX4    6
          BX4    X3+X4
 RCB4     BX4    -X0*X4
          BX1    X0*X2       UPDATE CHANNEL ACCESS BYTE IN MST
          BX6    X1+X4
          SA6    A2
 RCB5     SA3    A3          RESTORE *X3*
          SX2    B5          RESTORE *X2*
          JP     B6          EXIT
 SCH      SPACE  4,15
**        SCH - SET CHANNEL STATE.
*
*         ENTRY  (A3) = EST ENTRY ADDRESS.
*                (B5) = CHANNEL BYTE SHIFT COUNT.
*                (B6) = EXIT ADDRESS.
*                (X0) = MASK OF -12.
*                (X3) = WORD *EQDE* OF EST ENTRY.
*                (X6) = CHANNEL STATE TO BE SET.
*
*         USES   X - 1, 4, 6.
*                A - 6.
*                B - 3.
 
 
 SCH      SX1    3000B       CHANNEL STATE MASK
          LX1    B5
          BX4    -X1*X3      CLEAR CURRENT CHANNEL STATE
          SB3    B5+9
          LX6    B3
          BX6    X6+X4       SET NEW CHANNEL STATE
          SA6    A3
          SA3    A3          UPDATED *EQDE*
          JP     B6          EXIT
 SCTM     SPACE  4,30
***       SCTM - SET SYSTEM CONTROL PARAMETERS.
*
*         ENTRY
*T, OR    12/  SCTM,12/  SF,24/  P2,12/  P1
*
*         SF     SUBFUNCTION CODE.
*                CCSS  CONVERT CPU SCHEDULING PARAMETERS.
*
*         P1     SERVICE CLASS FOR SF = CCSS.
*
*         P2     RESERVED.
*
*         EXIT
*T, OR    12/  0,12/ ST,36/ 0
*
*         ST = 0 IF FUNCTION PERFORMED.
*
*         *PP HUNG.* WILL OCCUR FOR THE FOLLOWING CONDITIONS.
*
*         1)  ILLEGAL SUBFUNCTION.
*         2)  SERVICE CLASS OUT OF RANGE (CCSS).
 
 
          PPR    SCTM
 
          BX2    X1          GET SUBFUNCTION
          AX2    36
          SB4    X2-TSCTL
          PL     B4,HNG      IF ILLEGAL SUBFUNCTION
          JP     TSCT+TSCTL+B4  JUMP TO PROCESSOR
 
*         SUBFUNCTION TABLE.
 
 TSCT     BSS    0
          LOC    0
 
+         MX6    -12
          ERRNZ  *-CCSS      TABLE POSITION DEPENDS ON VALUE
          BX4    -X6*X1      GET SERVICE CLASS
          EQ     SCT1        (CCSS) - CONVERT CPU SCHEDULING PARAMETERS
 
 TSCTL    BSS    0
          LOC    *O
 
 
*         *CCSS* - CONVERT CPU SCHEDULING PARAMETERS.
 
 SCT1     ZR     X4,HNG      IF ZERO SERVICE CLASS
          SX6    X4-MXJC
          PL     X6,HNG      IF INCORRECT SERVICE CLASS
          SB3    SCT2        SET *CCP* RETURN ADDRESS
          EQ     CCP         CONVERT CPU SCHEDULING PARAMETERS
 
*         CHECK CONTROL POINTS FOR JOBS WITH CPU PRIORITY UPDATE
*         REQUIRED.  JOBS WITH JOB ADVANCE SET ARE BYPASSED.  *JACM*
*         PROCESSING WILL UPDATE THE CPU PRIORITY WHEN JOB ADVANCE IS
*         CLEARED.
 
 SCT2     SB7    200B        INITIALIZE CONTROL POINT ADDRESS
 SCT3     SA1    B7+TFSW     GET EJT ORDINAL
          SA3    B7+CWQW     GET CPU SCHEDULING PARAMETERS
          MX6    -12
          MX7    -9
          LX1    -48
          LX3    -27
          BX1    -X6*X1      EJT ORDINAL
          BX7    -X7*X3      *JCB* OFFSET
          ZR     X1,SCT4     IF CONTROL POINT NOT OCCUPIED
          TA2    X7+CSJT,JCB GET SERVICE CLASS CPU PRIORITY
          LX3    27
          UX0,B4 X3          UNPACK CPU PRIORITY
          SX7    B4+
          LX0    59-45
          AX7    3           JOB CPU PRIORITY WITHOUT FLAGS
          NG     X0,SCT4     IF PRIORITY NOT SET FROM SERVICE CLASS
          AX2    48          SERVICE CLASS CPU PRIORITY
          IX6    X7-X2
          ZR     X6,SCT4     IF CURRENT PRIORITY MATCHES SERVICE CLASS
          CX6    X1,EJT      SET EJT ENTRY OFFSET
          TA1    X6+JSNE,EJT GET JOB ADVANCE STATUS
          SX5    X2          SET CPU PRIORITY
          LX1    59-6
          SB3    SCT4        SET *SPR* RETURN ADDRESS
          PL     X1,SPR      IF JOB ADVANCE NOT SET
 SCT4     SB7    B7+200B     ADVANCE CONTROL POINT ADDRESS
          TX7    B7,-SCA
          NZ     X7,SCT3     IF NOT SYSTEM CONTROL POINT
          EQ     PPR1        CLEAR OUTPUT REGISTER AND EXIT
 SFBM     SPACE  4
***       SFBM - SET FILE BUSY.
*
*         ENTRY
*T, OR    12/  SFBM,12/,12/  EQ,6/,18/  ADDR
*T, MB    42/ FILE NAME,18/
*         ADDR   NFL ADDRESS OF FNT ENTRY.
*         EQ     IF EQ .NE. 0, SET IT IN THE EST ORDINAL
*                FIELD OF THE FST IF THE FILE IS NOT BUSY. THE
*                FST IS NOT SET BUSY WHEN THIS OPTION IS USED.
*
*
*         EXIT
*T, OR    12/  0,12/  ST,36/  0
*         ST = 0 IF FILE WAS NOT PREVIOUSLY BUSY.
*         ST = 1 IF FILE WAS PREVIOUSLY BUSY.
*         ST = 2 IF COMPARISON FAILED.
*
*         *PP HUNG.* WILL OCCUR FOR THE FOLLOWING CONDITIONS.
*         1)     IF ADDRESS BEYOND NFL SIZE
 
 
          PPR    SFBM
 
          SA3    B7+FLSW     GET NFL/100
          MX0    -RMSK
          AX3    RSHF
          BX2    -X0*X3      RA / 100
          MX0    -18
          AX3    36
          LX3    6
          SB4    X3          NFL SIZE
          BX3    -X0*X1      NFL ADDRESS
          SB6    X1
          GT     B6,B4,HNG   IF BEYOND NFL SIZE
          LX2    6
          SX7    B1
          IX2    X2-X3       ABSOLUTE ADDRESS FNT
          IX3    X2+X7       ABSOLUTE ADDRESS FST
          ERX4   X3          READ FST
          BX5    X7*X4
          BX6    -X7*X4      CLEAR BUSY BIT
          LX7    36          SET BUSY STATUS
          ZR     X5,PPR1     IF BUSY
          MX0    12
          LX1    24
          BX5    X0*X1
          ERX1   X2          READ FNT
          LX7    1           SET NO COMPARE STATUS
          SA4    A5+B1       READ COMPARE WORD FROM MESSAGE BUFFER
          BX4    X1-X4
          LX4    -12
          AX4    6
          NZ     X4,PPR1     IF NO COMPARE
          ZR     X5,SFB1     IF NO EST ORDINAL CHANGE
          SX7    B1
          BX6    -X0*X6
          BX6    X7+X6
          BX6    X5+X6
 SFB1     EWX6   X3          SET FST BUSY
          BX7    X7-X7       SET RESPONSE
          JP     PPR1        EXIT
 SJCM     SPACE  4,50
***       SJCM - SELECT JOB CONTROL PARAMETERS.
*
*         ENTRY
*T, OR    12/  SJCM,12/  SF,24/  P2,12/  P1
*
*         SF     SUBFUNCTION CODE.
*                CPRS  SET CPU PRIORITY.
*                CPUS  SELECT CPU FOR JOB.
*                SCTS  SET JOB CONTROL FLAG(S).
*                CCTS  CLEAR JOB CONTROL FLAG(S).
*                SSIS  SET SUBSYSTEM IDENTIFICATION.
*                SBKS  SET PP BREAKPOINT.
*                CBKS  CLEAR PP BREAKPOINT.
*                SAPS  SET *CPUPFM* ACTIVE.
*                CAPS  CLEAR *CPUPFM* ACTIVE.
*                SSPS  SET SCHEDULING PARAMETER INDEX.
*
*         P1     CPU PRIORITY FOR SF = CPRS.
*                0 = SET CPU PRIORITY TO SERVICE CLASS VALUE.
*
*         P1     CPU SELECTION FOR SF = CPUS.
*                0 = USE ANY CPU.
*                2 = USE CPU 0 ONLY.
*                1 = USE CPU 1 ONLY.
*
*         P1     6 BIT MASK FOR SF = SCTS, CCTS.
*                (APPLIED TO *JCIW* BITS 18 - 23).
*
*         P1     SUBSYSTEM IDENTIFICATION FOR SF = SSIS.
*
*         P1     CP NUMBER (OPTIONAL) FOR SF = SBKS.
*
*         P1     SCHEDULING PARAMETER INDEX FOR SF = SSPS.
*
*         P2     PP NAME (LEFT JUSTIFIED) FOR SF = SBKS.
*
*         EXIT
*T, OR    12/  0,12/  ST,36/  0
*
*         ST = 0 IF FUNCTION COMPLETE.
*         ST = 1 IF FUNCTION REJECTED (SF = SBKS, CBKS ONLY).
*                BREAKPOINT DISABLED (*0BK*/*7BK* NOT CM RESIDENT).
*                ATTEMPT TO SET BREAKPOINT WHEN ONE ALREADY SET.
*                ATTEMPT TO CLEAR BREAKPOINT WHEN NONE IS SET.
*                LIBRARY IS LOCKED (*SYSEDIT* RUNNING).
*
*         *PP HUNG.* WILL OCCUR FOR THE FOLLOWING CONDITIONS.
*         1)     REQUESTED CPU PRIORITY .GE. *MPRS* (CPRS).
*         2)     REQUESTED CPU PRIORITY .LT. *LJCS* (CPRS).
*         3)     REQUESTED CPU SELECTION .GT. 2 (CPUS).
 
 
          PPR    SJCM
 
          MX3    -12
          BX5    -X3*X1      EXTRACT PARAMETER
          LX1    11-47       POSITION TO SUBFUNCTION
          MX6    -6
          SA2    B7+JCIW     GET JOB CONTROL WORD
          BX1    -X3*X1      EXTRACT SUBFUNCTION
          BX6    -X6*X5
          SB4    X1-TSJCL
          PL     B4,HNG      IF ILLEGAL SUBFUNCTION
          JP     TSJC+TSJCL+B4  JUMP TO PROCESSOR
 
**        EXIT TO PROCESSOR WITH-
*
*         (A2) = ADDRESS OF *JCIW*.
*         (X2) = CONTENTS OF *JCIW*.
*         (X3) = 48/-0,12/0.
*         (X5) = PARAMETER VALUE.
*         (X6) = LOWER 6 BITS OF PARAMETER VALUE.
*         (X7) = 0.
 
*         SUBFUNCTION TABLE
 
 TSJC     BSS    0
          LOC    0
 
          ERRNZ  *-CPRS      TABLE POSITION DEPENDS ON VALUE
+         SA3    B7+CWQW     GET CPU PRIORITY
          EQ     SJC1        (CPRS) - SET CPU PRIORITY
 
          ERRNZ  *-CPUS      TABLE POSITION DEPENDS ON VALUE
+         SA1    B7+CWQW     GET CPU ASSIGNMENT FLAGS
          EQ     SJC2        (CPUS) - SELECT CPU FOR JOB
 
          ERRNZ  *-SCTS      TABLE POSITION DEPENDS ON VALUE
+         LX6    23-5        POSITION BIT MASK
          BX6    X6+X2       SET REQUESTED BITS
          EQ     SJC5        (SCTS) - SET JOB CONTROL FLAG(S)
 
          ERRNZ  *-CCTS      TABLE POSITION DEPENDS ON VALUE
+         LX6    23-5        POSITION BIT MASK
          BX6    -X6*X2      CLEAR REQUESTED BITS
          EQ     SJC5        (CCTS) - CLEAR JOB CONTROL FLAG(S)
 
          ERRNZ  *-SSIS      TABLE POSITION DEPENDS ON VALUE
+         LX3    35-11       POSITION MASK TO BYTE 2
          LX5    35-11       POSITION PARAMETER TO BYTE 2
          EQ     SJC4        (SSIS) - SET SUBSYSTEM IDENTIFICATION
 
          ERRNZ  *-SBKS      TABLE POSITION DEPENDS ON VALUE
+         SX6    1
          EQ     SJC6        (SBKS) - SET PP BREAKPOINT
 
          ERRNZ  *-CBKS      TABLE POSITION DEPENDS ON VALUE
+         SX6    -1
          EQ     SJC6        (CBKS) - CLEAR PP BREAKPOINT
 
          ERRNZ  *-SAPS      TABLE POSITION DEPENDS ON VALUE
+         SX6    1
          EQ     SJC12       (SAPS) - SET *CPUPFM* ACTIVE
 
          ERRNZ  *-CAPS      TABLE POSITION DEPENDS ON VALUE
+         SX6    B0+
          EQ     SJC12       (CAPS) - CLEAR *CPUPFM* ACTIVE
 
          ERRNZ  *-SSPS      TABLE POSITION DEPENDS ON VALUE
+         SA2    B7+TFSW     GET EJT ORDINAL
          EQ     SJC13       (SSPS) - SET SCHEDULING PARAMETER INDEX
 
 TSJCL    BSS    0
          LOC    *O
 
*         SET CPU PRIORITY.
 
 SJC1     SX0    B1+
          SB3    RZX         SET *SPR* RETURN ADDRESS
          LX0    45-0
          ZR     X5,SJC1.1   IF SET PRIORITY FROM SERVICE CLASS
          BX3    X3+X0       INDICATE PRIORITY NOT FROM SERVICE CLASS
          SX6    X5-MPRS
          SX7    X5-LJCS
          PL     X6,HNG      IF PRIORITY NOT VALID
          NG     X7,HNG      IF PRIORITY NOT VALID
          EQ     SPR         SET CPU PRIORITY
 
 SJC1.1   BX3    -X0*X3      INDICATE PRIORITY SET FROM SERVICE CLASS
          MX6    -9
          LX3    -27
          BX1    -X6*X3
          TA1    X1+CSJT,JCB GET SERVICE CLASS CPU PRIORITY
          LX3    27
          AX1    48
          SX5    X1          SERVICE CLASS CPU PRIORITY
          EQ     SPR         SET CPU PRIORITY
 
*         SET CPU SELECTION.
 
 SJC2     SX6    X5-3
          MX3    -2
          LX5    24
          PL     X6,HNG      IF CPU SELECTION NOT VALID
          LX3    24
          BX6    X3*X1       CLEAR CPU ASSIGNMENT FLAGS
          BX6    X6+X5       MERGE SELECTION FLAGS
          TJP    (/DCP/SJC,DCPC,/MONITOR/SJC3)
 SJC3     LX3    36-24
          LX5    36-24
          SA6    B7+CWQW     UPDATE *CWQW*
 
*         SET PARAMETER IN *JCIW*.
 
 SJC4     BX6    X3*X2       CLEAR OLD PARAMETER
          SB0    0
          BX6    X6+X5       INSERT PARAMETER
 
*         COMPLETE PROCESSING OF FUNCTION.
 
 SJC5     BX7    X7-X7       CLEAR OUTPUT REGISTER
          SA6    A2          UPDATE *JCIW*
          EQ     PPR1        RETURN
 
*         SET / CLEAR PP BREAKPOINT.
 
 SJC6     SA5    A5+         REREAD OUTPUT REGISTER
          SA3    PSTP
          SA2    PLDP        FETCH PLD POINTER
          AX3    12
          LX5    24          POSITION NAME
          MX0    18
          SB4    X3-2        LWA+1 PLD
          AX2    36
          BX5    X0*X5       ISOLATE NAME
          SB3    X2
          ZR     X2,SJC7     IF NO PLD POINTER (LIBRARY LOCKED)
          SA3    B3-3
          BX1    -X0*X3      *0BK* LOAD INFORMATION
          SA4    A3+B1
          AX3    42
          BX2    -X0*X4      BREAKPOINTED PP STATUS
          SX3    X3-3R"PBK0"
          PL     X6,SJC8     IF SETTING BREAKPOINT
          BX5    X0*X4
          NO
          NZ     X2,SJC9     IF BREAKPOINT SET
          SB0    0
 SJC7     SX7    B1          FLAG ERROR
          LX7    37
          EQ     PPR1        RETURN
 
 SJC8     NZ     X2,SJC7     IF BREAKPOINT ALREADY SET
 
 SJC9     NZ     X3,SJC7     IF *0BK* NOT FOUND
 SJC10    SA2    B3
          GE     B3,B4,SJC7  IF PP ROUTINE NOT FOUND
          BX3    X0*X2
          SB3    B3+B1       ADVANCE PLD ADDRESS
          IX3    X3-X5
          NZ     X3,SJC10    IF NOT MATCHING NAME
          MX3    -12
          PL     X6,SJC11    IF SETTING BREAKPOINT
          BX6    X4
          SA6    A2          RESTORE CORRECT ENTRY
          MX6    1
          SA6    A4          CLEAR OUT BREAKPOINT
          SA6    A6+B1
          EQ     PPR1        RETURN
 
 SJC11    BX1    X5+X1       MERGE NAME AND *0BK* LOAD DATA
          BX6    -X3*X2
          BX6    X6+X1       APPEND PP LOAD ADDRESS
          SA6    A2
          SA1    A5          REREAD OUTPUT REGISTER
          BX6    X2
          SX4    B1
          BX1    -X3*X1      EXTRACT CP NUMBER (IF ANY)
          SA6    A4
          LX4    41
          BX6    -X0*X2      PP LOAD INFORMATION
          LX1    48+7
          IX6    X6+X4       ADD IN RESIDENCY FLAG
          BX6    -X4*X6
          BX6    X1+X6       MERGE IN CPA ADDRESS
          SA6    A4+B1
          EQ     PPR1        RETURN
 
*         SET/CLEAR *CPUPFM* ACTIVE FLAG.
 
 SJC12    MX7    59          SET/CLEAR *CPUPFM* ACTIVE FLAG
          LX6    39-0
          LX7    39-0
          BX7    X7*X2
          BX6    X7+X6
          EQ     SJC5        COMPLETE PROCESSING
 
*         SET SCHEDULING PARAMETER INDEX.
 
 SJC13    SX6    X5-MXJC*JCBE
          PL     X6,HNG      IF INDEX OUT OF RANGE
          LX2    12
          BX2    -X3*X2      EJT ORDINAL
          CX0    X2,EJT
          TA1    X5+EXQT,JCB GET UPPER BOUND SCHEDULING PRIORITY
          TA2    X0+SCHE,EJT GET EJT SCHEDULING DATA
          LX1    -24
          BX2    X3*X2
          BX1    -X3*X1
          BX6    X2+X1       SET SCHEDULING PRIORITY TO UPPER BOUND
          SA3    B7+CWQW     GET CPU SCHEDULING PARAMETERS
          SA6    A2          UPDATE *SCHE*
          MX0    -9
          LX3    -27
          BX6    X0*X3
          BX6    X6+X5       SET PARAMETER IN *CWQW*
          LX3    59-45+27
          LX6    27
          SA6    A3          UPDATE *CWQW*
          NG     X3,PPR1     IF CPU PRIORITY NOT SET FROM SERVICE CLASS
          TA1    X5+CSJT,JCB GET SERVICE CLASS CPU PRIORITY
          SB3    RZX         SET *SPR* RETURN ADDRESS
          AX1    48
          BX3    X6
          SX5    X1          SERVICE CLASS CPU PRIORITY
          EQ     SPR         SET CPU PRIORITY
 SMDM     SPACE  4,30
***       SMDM - SET MST DATA.
*         THIS FUNCTION PERFORMS MST UPDATING FUNCTIONS THAT DO NOT
*         REQUIRE THE MST TO BE INTERLOCKED.
*
*         ENTRY
*T, OR    12/ SMDM,12/ EQ,12/ PA,12/ SF,12/ PB
*
*         EQ     EST ORDINAL.
*         PA     PARAMETER WHOSE USE DEPENDS ON THE SUBFUNCTION
*                BEING PERFORMED.
*         PA =   BIT NUMBER FOR SF = CLBS/SLBS.
*         PA =   ERROR STATUS FOR SF = SERS/CERS.
*         PA =   TRACK NUMBER FOR SF = USTS/SFTS/CFTS.
*         PA =   STATUS BITS FOR SF = SSTS.
*         PA =   BYTE NUMBER FOR SF = ICTS.
*         SF     SUBFUNCTION CODE.
*                SLBS = 0 = SET LOCAL BIT.                    (STLL)
*                CLBS = 1 = CLEAR LOCAL BIT.                  (STLL)
*                IUCS = 2 = INCREMENT USER COUNT FIELD.       (STLL)
*                DUCS = 3 = DECREMENT USER COUNT FIELD.       (STLL)
*                SERS = 4 = SET ERROR STATUS.                 (STLL)
*                CERS = 5 = CONDITIONALLY CLEAR ERROR STATUS. (STLL)
*                IFCS = 6 = INCREMENT FAMILY COUNT.           (DULL)
*                DFCS = 7 = DECREMENT FAMILY COUNT.           (DULL)
*                TFIS = 10B = TOGGLE FAMILY IDLE STATUS.      (DULL)
*                USTS = 11B = UPDATE SYSTEM TABLE TRACK.      (DULL)
*                SFTS = 12B = SET FAILING TRACK.              (NVGL)
*                CFTS = 13B = CLEAR FAILING TRACK.            (NVGL)
*                SSTS = 14B = SET EQUIPMENT STATE.            (DALL)
*                ICTS = 15B = INCREMENT ERROR COUNTER.   (CTLL/EDLL)
*                CTCS = 16B = CLEAR TABLES-CURRENT (ISHARED). (SDGL)
*                C1AS = 17B = CLEAR *1RU* ACTIVITY (ISHARED). (MCLL)
*         PB     PARAMETER WHOSE USE DEPENDS ON THE SUBFUNCTION
*                BEING PERFORMED.
*         PB =   BIT MASK FOR BITS TO CHANGE FOR SF = SSTS.
*
*         EXIT
*T, OR    12/  0,12/  ST,36/
*         ST = 0, IF FUNCTION PERFORMED.
*         ST = 1  IF BIT ALREADY SET FOR SLBS.
*         ST = 1  IF MATCHING TRACK NUMBER FOR SFTS.
*         ST = 1  IF NON-MATCHING TRACK NUMBER FOR CFTS.
*         ST = 1  IF DEVICE ASSIGNED AND DOWN FOR SSTS.
*         ST = BYTE 4 OF *DULL* FOR TFIS.
*
*         *PP HUNG.* WILL OCCUR IF -
*         1)  IF BIT NUMBER OUT OF RANGE.  (SLBS/CLBS)
*         2)  IF ERROR CODE OUT OF RANGE.  (SERS/CERS)
 SMDM     SPACE  4,20
**        TSMD - TABLE OF SMDM SUBFUNCTION PARAMETERS.
*         THERE IS A *TSMD* ENTRY FOR EVERY TWO CONSECUTIVE SMDM
*         SUBFUNCTION CODES.  EACH ENTRY CONTAINS THE RETURN ADDRESS
*         FOR ROUTINE *CTR*.  THE SECOND ENTRY IS CORRECTLY POSITIONED
*         IN THE WORD.  THE FIRST ENTRY IS POSITIONED BY LEFT SHIFTING
*         THE WORD BY 30 BITS.
*
*         THE ENTRIES ARE BUILT BY THE *SMD* MACRO.
*
*         SMD    SF1,SF2,BLOCK
*
*                SF1,SF2  TWO CONSECUTIVE SUBFUNCTION CODES.
*                BLOCK    THE NAME OF THE *CPUMTR* BLOCK THAT CONTAINS
*                         THE PROCESSOR WHEN IT IS CONDITIONALLY
*                         LOADED.  THE DEFAULT ASSUMES THE PROCESSOR IS
*                         UNCONDITIONALLY LOADED.
 
 
 SMD      SFMACRO  PAIRED    DEFINE THE *SMD* MACRO
 
 TSMD     BSS    0           TABLE OF SMDM OPTION PARAMETERS.
 
          SMD    SLBS,CLBS
          SMD    IUCS,DUCS
          SMD    SERS,CERS
          SMD    IFCS,DFCS
          SMD    TFIS,USTS
          SMD    SFTS,CFTS
          SMD    SSTS,ICTS
          SMD    CTCS,C1AS,ISD
 
          LOC    *O
 TSMDL    EQU    *-TSMD      END OF TABLE
 
 
          PPR    SMDM
 
          SX4    X1          CHECK SUBFUNCTION
          ERRPL  TSMDL-11B   CODE ASSUMES NO SUBFUNCTION .GT. 37B
          SB5    PPRX        SET ERROR EXIT ADDRESS
          LX4    -14
          SA2    X4+TSMD     READ OPTION TABLE
          SB6    X4-TSMDL    CHECK LEGALITY OF OPTION
          NG     X4,SMD1     IF SECOND ENTRY IN OPTION TABLE WORD
          LX2    30          SHIFT TO SECOND ENTRY
 SMD1     PL     B6,HNG      IF ILLEGAL OPTION
          SB3    X2          SET *CTR* RETURN
          SB6    B0          SET *CTR* PARAMETER
          NG     X2,HNG      IF UNUSED SUBFUNCTION
          EQ     /PROGRAM/CTR1  CHECK TRACK REQUEST
 
*         SET LOCAL MST BIT.
 
          SUBFUN SMDM,(SLBS,CLBS)
          SX7    X1-60
          PL     X7,HNG      IF BIT NUMBER OUT OF RANGE
          SA4    A3+STLL     READ MST WORD
          SX7    B1
          SB3    X1
          BX2    X7*X2       CHECK FOR INCREMENT/DECREMENT
          LX1    X7,B3       POSITION MST BIT
          UX0    X0          GET SHARED STATUS
          BX6    -X1*X4
          NZ     X2,SMD2     IF CLEARING BIT
          BX4    X1*X4
          BX6    X6+X1
          ZR     X4,SMD2     IF BIT NOT PREVIOUSLY SET
          LX7    36          POSITION REJECT STATUS
 SMD2     SA6    A4          STORE MST WORD
          SA7    A5          STORE OUTPUT REGISTER
          NG     X0,PPRX     IF NON-SHARED
          TNZ    X0,(/PROGRAM/CLM,MMF,/MONITOR/PPRX)  IF MMF DEVICE
          EQ     PPRX        EXIT
 
*         INCREMENT/DECREMENT USER COUNTS.
 
          SUBFUN SMDM,(IUCS,DUCS)
          SX3    10000B
          SA4    A3+STLL     READ USER COUNT WORD
 SMD3     LX2    -1          POSITION INCREMENT/DECREMENT BIT
          AX2    59
          BX2    X2-X3       (X2) = 1 IF INCREMENT, -1 IF DECREMENT
          LX3    11
          IX6    X4+X2       PERFORM INCREMENT/DECREMENT
          BX7    X4-X6       CHECK FOR OVERFLOW/UNDERFLOW
          BX7    X3*X7
          SB6    B0
          ZR     X7,SMD2     IF NO OVERFLOW/UNDERFLOW
          EQ     SMD8        RETURN OVERFLOW STATUS
 
*         SET ERROR STATUS / CONDITIONALLY CLEAR ERROR STATUS.
 
          SUBFUN SMDM,(SERS,CERS)
          SX7    X1-MXEC
          PL     X7,HNG      IF ERROR CODE OUT OF RANGE
          SA4    A3+STLL     READ ERROR STATUS WORD
          LX2    -1
          MX0    -6
          LX4    -36         POSITION ERROR STATUS
          BX6    X0*X4       CLEAR OLD ERROR STATUS
          PL     X2,SMD4     IF *SERS* SUBFUNCTION
          BX7    -X0*X4      COMPARE ERROR STATUS
          BX1    X7-X1
          NZ     X1,PPR1     IF NOT CLEARING DIFFERENT STATUS
 SMD4     BX7    X6+X1       MERGE ERROR STATUS
          LX7    36
          EQ     SMD6        STORE NEW ERROR STATUS AND EXIT
 
*         INCREMENT / DECREMENT FAMILY COUNT SUBFUNCTIONS.
 
          SUBFUN SMDM,(IFCS,DFCS)
          SA4    A3+DULL     READ MST WORD
          SX3    B1+         SET INCREMENT/DECREMENT VALUE
          EQ     SMD3        INCREMENT/DECREMENT FIELD
 
*         TOGGLE FAMILY IDLE STATUS.
 
          SUBFUN SMDM,(TFIS,USTS)
          LX2    -1          TEST FUNCTION CODE
          MX3    1
          SA4    A3+DULL-TDGL
          NG     X2,SMD5     IF *USTS* SUBFUNCTION
          LX3    12
          BX6    X4-X3
          MX7    -48
          LX4    36
          BX7    -X7*X4
          SA6    A4          STORE RESULT
          SA7    A5          STORE OUTPUT REGISTER
          EQ     PPRX        EXIT TO STORE OUTPUT REGISTER
 
*         UPDATE SYSTEM TABLE TRACK.
 
 SMD5     LX4    -12
          BX4    X5*X4       CLEAR OLD SYSTEM TABLE TRACK
          BX7    X1+X4       MERGE NEW SYSTEM TABLE TRACK
          LX7    12
 SMD6     SA7    A4          STORE MST WORD
          BX7    X7-X7       CLEAR OUTPUT REGISTER
          EQ     PPR1        EXIT AND STORE OUTPUT REGISTER
 
*         SET / CLEAR FAULTY TRACK.
 
          SUBFUN SMDM,(SFTS,CFTS)
          MX7    -11         CHECK TRACK WITHIN TRT
          AX3    48
          BX7    -X7*X1      CLEAR UPPER BIT OF REQUESTED TRACK
          IX7    X7-X3
          PL     X7,PPR1     IF INCORRECT TRACK NUMBER
          SA4    A3+NVGL-TDGL  GET CURRENT TRACK-TO-FLAW
          MX7    1
          LX1    48          POSITION TRACK NUMBER
          LX2    -1
          ERRNZ  SFTS-SFTS/2*2  CODE ASSUMES *SFTS* IS EVEN
          ERRZR  CFTS-CFTS/2*2  CODE ASSUMES *CFTS* IS ODD
          BX1    X1+X7       ENSURE THAT BIT 11 IS SET IN TRACK NUMBER
          MX6    12
          BX3    X6*X4
          BX6    -X6*X4
          BX3    X3-X1       COMPARE TRACK NUMBER WITH CURRENT TRACK
          SA4    A3+STLL-TDGL
          NG     X2,SMD7     IF *CFTS*
          ZR     X3,SMD8     IF SETTING SAME TRACK
          SX3    B0
          BX6    X1+X6       SET NEW TRACK
 SMD7     NZ     X3,SMD8     IF CLEARING WRONG TRACK
          SA6    A3+NVGL-TDGL
          LX7    50-59       SET CHECKPOINT REQUEST FLAG
          BX7    X4+X7
          EQ     SMD6        STORE CHECKPOINT REQUEST FLAG AND RETURN
 
*         SSTS - SET EQUIPMENT STATE.
 
          SUBFUN SMDM,(SSTS,ICTS)
          SX2    X2-SSTS
          SA4    A3+DALL-TDGL  UPDATE STATE BITS IN *DALL*
          NZ     X2,SMD9     IF *ICTS*
          BX7    -X5*X7      GET BIT MASK
          LX1    54-0        GET NEW STATUS
          LX7    54-0
          LX3    X4,B1       SAVE PREVIOUS STATE
          BX3    X3*X4
          BX4    -X7*X4      CLEAR BITS TO SET
          LX3    59-57
          BX7    X4+X1       MERGE BITS TO SET
          PL     X3,SMD6     IF PREVIOUS STATE NOT DOWN
          SA1    A5          REREAD OUTPUT REGISTER
          MX3    -9
          LX1    24
          BX3    -X3*X1      EST ORDINAL
          CX2    X3,EST      CONVERT EST ORDINAL TO OFFSET
          TA2    X2+EQAE,EST
          BX2    -X5*X2
          ZR     X2,SMD6     IF DEVICE NOT ASSIGNED
 SMD8     SX7    B1          SET REJECT STATUS
          LX7    36
          EQ     PPR1        EXIT TO RETURN REJECT STATUS
 
*         ICTS - INCREMENT ERROR COUNTER.
 
 SMD9     SA2    A3+EDLL-TDGL
          SA4    PDTL
          BX6    X4
          SA6    A2          SET PACKED DATE AND TIME OF LAST ERROR
          SX6    4
          SA4    A2-B1
          ERRNZ  EDLL-CTLL-1 CODE DEPENDS ON VALUE
          AX5    1           SET MASK = -3777
          IX2    X6-X1       4 - BYTE NUMBER
          LX3    X2,B1       *2
          IX3    X2+X3       *3
          LX3    2           (4 - BYTE NUMBER) * 12
          SB3    X3
          SX2    B1
          LX5    B3          POSITION MASK
          LX2    B3          POSITION INCREMENT
          BX3    X5*X4       CLEAR COUNTER FIELD
          IX7    X2+X4       INCREMENT COUNTER
          BX7    -X5*X7      MASK OFF OVERFLOW
          BX7    X7+X3       MERGE COUNTER FIELD AND REST OF WORD
          EQ     SMD6        UPDATE *CTLL* WORD AND EXIT
 SPLM     SPACE  4
***       SPLM - SEARCH PERIPHERAL LIBRARY.
*
*         ENTRY
*T, OR    12/  SPLM,12/,5/0,1/A,18/  PN,12/
*         A      IF SET, *PLD* ADDRESS AND PP NAME RETURNED ON EXIT,
*                RATHER THAN LOAD PARAMETERS.
*         PN     PP PACKAGE NAME.
*
*         EXIT
*T, OR    12/  0,6/  RT,6/  EQ,12/  TK,12/  SN,12/  LA     (MS)
*T, OR    12/  0,6/  RT,18/  PA,12/  PL,12/  LA            (RPL)
*T, OR    12/  0,6/  RT,18/  SA,12/  PL,12/  LA            (SFP)
*T, OR    12/  0,5/0,1/1,18/  PN,24/  DA
*         EQ     EST ORDINAL.
*         SA     ADDRESS OF *SFP* IN *RPL*.
*         PA     PROGRAM ADDRESS.
*         LA     LOAD ADDRESS.
*         PL     PROGRAM LENGTH.
*         TK     TRACK.
*         SN     SECTOR.
*         RT     RESIDENCE AND TYPE CODE.
*                0 = 12-BIT, MS RESIDENT (NPP).
*                1 = 12-BIT, *RPL* RESIDENT.
*                2 = *SFP*.
*                10 = 16-BIT, *RPL* RESIDENT.
*                14 = 16-BIT, MS RESIDENT (NPP).
*                     MS RESIDENT (CPP).
*         PN     PP PACKAGE NAME.
*         DA     PP PACKAGE *PLD* ADDRESS (0 IF NOT FOUND).
 
 
          PPR    SPLM,,,FEX
 
          BX6    X5
          SB6    CSM         SET EXIT ADDRESS
          LX6    30          POSITION PROGRAM NAME
          SX1    B1
          BX1    X1*X6
          TZR    X1,(/CPP/SPL,CPP,/MONITOR/SPL)  IF NOT *PLD*/PP NAME
          SB6    SPM1        SET RETURN ADDRESS
          TEQ    (/CPP/SPL,CPP,/MONITOR/SPL)  SEARCH PERIPHERAL LIBRARY
 
 SPM1     NG     X1,PPR1     IF LIBRARY LOCKED
          MX4    19
          LX4    1
          BX7    X4*X6       PROGRAM NAME AND ADDRESS FLAG
          LX7    -18
          SX1    A1          RETURN *PLD* ENTRY ADDRESS
          BX7    X7+X1
          EQ     CSM         CHECK FOR STORAGE MOVE
 STBM     SPACE  4,30
***       STBM - SET TRACK BIT.
*         THIS FUNCTION PERFORMS MST AND TRT UPDATING FUNCTIONS.
*         THE MST/TRT MUST BE INTERLOCKED TO PREVENT A PROGRAM MODE
*         REQUEST FROM WORKING WITH THE SAME MST/TRT.
*
*         ENTRY
*T, OR    12/ STBM,1/ CK,1/ RT,10/ EQ,12/ PM,12/ SF,12/
*
*         CK     IF CK = 1 SET CHECKPOINT BIT.
*         RT     RETURN TRACK NOT RESERVED STATUS.
*         EQ     EQUIPMENT.
*         PM     PARAMETER WHOSE USE DEPENDS ON THE SUBFUNCTION
*                BEING PERFORMED.
*         PM =   TRACK FOR SF = STFS/CTFS/STIS/CTIS/SPFS/CPFS.
*         PM =   IQFT TRACK FOR SIQS SUBFUNCTIONS.
*         PM =   BIT NUMBER FOR CGBS/SGBS SUBFUNCTIONS.
*         PM =   NEW UNIT/COUNT FOR SOUS/SRCS SUBFUNCTIONS.
*         SF     SUBFUNCTION CODE.
*                STFS =  0 = SET TRACK FLAWED STATUS.
*                CTFS =  1 = CLEAR TRACK FLAWED STATUS.
*                STIS =  2 = SET TRACK INTERLOCKED BIT.
*                CTIS =  3 = CLEAR TRACK INTERLOCKED STATUS.
*                SPFS =  4 = SET PRESERVED FILE STATUS BIT.
*                CPFS =  5 = CLEAR PRESERVED FILE STATUS BIT.
*                UTRS =  6 = UPDATE TRT FROM ECS.
*                UITS =  7 = UPDATE ISHARED TABLES.
*                IIQS = 10B = INTERLOCK IQFT TRACK.
*                SIQS = 11B = SET IQFT TRACK.
*                SGBS = 12B = SET GLOBAL MST BIT.   (ACGL)
*                CGBS = 13B = CLEAR GLOBAL MST BIT. (ACGL)
*                IPAS = 14B = INCREMENT PF ACTIVITY COUNT.  (DULL)
*                DPAS = 15B = DECREMENT PF ACTIVITY COUNT.  (DULL)
*                SPIS = 16B = SET PF INTERLOCK.             (DULL)
*                CPIS = 17B = CLEAR PF INTERLOCK.           (DULL)
*                SIIS = 20B = SET *INSTALL* INTERLOCK.      (DULL)
*                CIIS = 21B = CLEAR *INSTALL* INTERLOCK.    (DULL)
*                SLTS = 22B = SET LONG-TERM INTERLOCK.      (MCLL)
*                CDIS = 23B = CLEAR DEVICE INTERLOCK.       (SDGL)
*                SDIS = 24B = SET DEVICE INTERLOCK.         (SDGL)
*                SVIS = 26B = SET VERIFICATION INTERLOCK.   (DULL)
*                CVIS = 27B = CLEAR VERIFICATION INTERLOCK. (DULL)
*                SOUS = 30B = SET OFFLINE DAS PARITY UNIT.  (ACGL)
*                SRCS = 31B = SET REMAINING CYLINDERS.      (ACGL)
*
*         EXIT
*T, OR    12/  0,12/  ST,36/
*         ST = 0, IF FUNCTION PERFORMED.
*         ST = 1  IF BIT ALREADY SET FOR STFS/STIS/SPFS/SGBS.
*         ST = 1  IF NO IQFT TRACK OR IQFT TRACK PREVIOUSLY INTERLOCKED
*                 FOR *IIQS* OPTION.
*         ST = 1  IF CANNOT HONOR PF REQUEST DUE TO
*                 PF SYSTEM INTERLOCK OR TOO MANY PFM,S ACTIVE.
*         ST = 2  IF TRACK NOT RESERVED.
*         ST = IPC  FOR *SPIS* SUBFUNCTION WHERE -
*                I = 1/0, SET IF PF INTERLOCK SET BY REQUEST.
*                PC = 6/0,  IF NO PFM,S ACTIVE.
*
*         *PP HUNG.* WILL OCCUR IF -
*         1)  IF TRACK NOT RESERVED.     (CTFS/STIS/CTIS/SPFS/CPFS/IIQS)
*         2)  IF TRACK NOT INTERLOCKED.  (CTIS)
*         3)  IF TRACK NOT PRESERVED.    (CPFS)
*         4)  IF TRACK NOT FLAWED.       (CTFS)
*         5)  IF TRACK INFORMATION NOT ZERO.  (STFS)
*         6)  IF MST/TRT INTERLOCK NOT SET.   (SLTS/CDIS)
*         7)  IF BIT NUMBER OUT OF RANGE.     (SGBS/CGBS)
*         8)  IF PARAMETER VALUE TOO LARGE.   (SOUS/SRCS)
*
*         THIS FUNCTION MAY BE REJECTED IF THE MST/TRT IS INTERLOCKED.
*         WHEN THIS OCCURS BIT 59 OF *OR* IS SET AND *PPR* WILL RECALL
*         *CPUMTR* TO RETRY THE REQUEST.  THE REQUEST WILL BECOME
*         STORAGE MOVABLE WHEN IT IS REJECTED.
*         BIT 0 OF *SDGL* INTERLOCKS THE MST/TRT BETWEEN MONITOR AND
*         PROGRAM MODE.
*         FOR SHARED DEVICES BITS 1-5 INDICATES WHICH MACHINE HAS
*         THE MST/TRT INTERLOCKED IN EXTENDED MEMORY.
*         FOR INDEPENDENT SHARED DEVICES BITS 1-5 ARE USED BY *1RU*
*         TO INDICATE THE DEVICE IS INTERLOCKED IN THE LABEL.
*         THE MST/TRT INTERLOCK CONTROLS THE UPDATING OF THE TRT
*         AND MST WORDS TDGL AND ACGL.
*
*         NOTE - IF THE REQUEST IS FOR AN INDEPENDENT SHARED DEVICE,
*         THE MST, TRT, AND DIT ARE READ FROM THE DEVICE TO CM BY *1RU*
*         BEFORE THE STBM IS PROCESSED BY *CPUMTR*.
 STBM     SPACE  4,20
**        TSTB - TABLE OF STBM SUBFUNCTION PARAMETERS.
*         THERE IS A *TSTB* ENTRY FOR EVERY TWO CONSECUTIVE STBM
*         SUBFUNCTION CODES.  EACH ENTRY CONSISTS OF A PARAMETER AND
*         RETURN ADDRESS FOR ROUTINE *CTR*.  TWO ENTRIES ARE PACKED
*         IN A WORD SUCH THAT THE LOWER 18 AND UPPER 12 BITS FORM
*         AN ENTRY.  THE SECOND ENTRY IS CORRECTLY POSITIONED IN THE
*         WORD.  THE FIRST ENTRY IS POSITIONED BY LEFT SHIFTING THE
*         WORD BY 30 BITS.
*
*         THE ENTRIES ARE BUILT BY THE *STB* MACRO.
*
*         STB    SF1,SF2,(OPTIONS),BLOCK
*
*                SF1,SF2  TWO CONSECUTIVE SUBFUNCTION CODES.
*                OPTIONS  OPTIONS TO BE PASSED TO *CTR*.
*                         *DI* = SET DEVICE INTERLOCK.
*                BLOCK    THE NAME OF THE *CPUMTR* BLOCK THAT CONTAINS
*                         THE PROCESSOR WHEN IT IS CONDITIONALLY
*                         LOADED.  THE DEFAULT ASSUMES THE PROCESSOR IS
*                         UNCONDITIONALLY LOADED.
 
 
 STB      SFMACRO  PAIRED,(DI=1)  DEFINE THE *STB* MACRO
 
 TSTB     BSS    0           TABLE OF STBM OPTION PARAMETERS.
 
          STB    STFS,CTFS,DI
          STB    STIS,CTIS,DI
          STB    SPFS,CPFS,DI
          STB    UTRS,UITS,DI
          STB    IIQS,SIQS,DI
          STB    SGBS,CGBS,DI
          STB    IPAS,DPAS,DI
          STB    SPIS,CPIS,DI
          STB    SIIS,CIIS,DI
          STB    SLTS,CDIS
          STB    SDIS,25BS,DI
          STB    SVIS,CVIS,DI
          STB    SOUS,SRCS,DI
 
          LOC    *O
 TSTBL    EQU    *-TSTB      END OF TABLE
 
 
          PPR    STBM,,STB
 
          SX4    X1          CHECK SUBFUNCTION
          ERRPL  TSTBL-11B   CODE ASSUME NO SUBFUNCTION .GT. 37B
          SB5    PPRX        SET ERROR EXIT ADDRESS
          LX4    -14
          SA2    X4+TSTB     READ OPTION TABLE
          SB6    X4-TSTBL    CHECK LEGALITY OF OPTION
          NG     X4,STB1     IF SECOND ENTRY IN OPTION TABLE WORD
          LX2    30          SHIFT TO SECOND ENTRY
 STB1     PL     B6,HNG      IF ILLEGAL OPTION
          NG     X2,HNG      IF UNUSED SUBFUNCTION
          SB3    X2          SET *CTR* RETURN
          UX2,B6 X2          SET *CTR* PARAMETER
          TNZ    B6,(/ISD/CHR,ISD,/PROGRAM/CTR1)  IF INTERLOCK NEEDED
          EQ     /PROGRAM/CTR1  CHECK TRACK REQUEST
 
*         SET GLOBAL MST BIT.
 
          SUBFUN STBM,(SGBS,CGBS)
          SX7    X1-60
          PL     X7,HNG      IF BIT NUMBER OUT OF RANGE
          SA4    A3+ACGL     READ MST WORD
          SX7    B1
          SB3    X1
          BX2    X7*X2       CHECK FOR INCREMENT/DECREMENT
          LX1    X7,B3       POSITION MST BIT
          BX6    -X1*X4
          NZ     X2,STB2     IF CLEARING BIT
          BX4    X1*X4
          BX6    X6+X1
          ZR     X4,STB2     IF BIT NOT PREVIOUSLY SET
          LX7    36          POSITION REJECT STATUS
 STB2     SA6    A4          STORE MST WORD
          EQ     /PROGRAM/CCP1  EXIT
 
*         SET/CLEAR IQFT TRACK.
*         SET IQFT TRACK INTERLOCKED.
 
          SUBFUN STBM,(IIQS,SIQS)
          SA4    A3+ACGL     READ MST WORD
          LX4    -12         POSITION OLD IQFT TRACK
          BX3    X1          NEW IQFT TRACK
          LX2    -1
          BX1    -X5*X4      OLD IQFT TRACK
          PL     X2,/PROGRAM/STB2  IF *IIQS* SUBFUNCTION
          BX6    X5*X4       CLEAR OLD TRACK
          BX6    X3+X6       MERGE NEW IQFT TRACK
          LX6    12
          EQ     STB2        RETURN COMPLETED STATUS
 
 STB3     SX7    B1
          LX7    36          SET REJECT STATUS
          EQ     /PROGRAM/CCP1  CLEAR MST INTERLOCK
 
*         SET DEVICE INTERLOCK.
 
          SUBFUN STBM,(SDIS,25BS)
          LX2    -1
          UX0    X0
          NG     X2,HNG      IF UNUSED SUBFUNCTION
          ERRNZ  SDIS-SDIS/2*2  CODE ASSUMES *SDIS* IS EVEN
          NZ     X0,/PROGRAM/CSM1  IF NOT ISHARED DEVICE
          TEQ    (/ISD/STB2,ISD,/MONITOR/HNG1)  PROCESS ISHARED DEVICE
 
*         SET LONG-TERM INTERLOCK (ISHARED ONLY).
*         CLEAR DEVICE INTERLOCK.
 
          SUBFUN STBM,(SLTS,CDIS)
          SA4    A4          READ *SDGL* WORD
          BX1    X1-X1
          SX5    B4+
          LX2    -1
          LX4    -1
          PL     X4,HNG      IF DEVICE NOT INTERLOCKED
          NG     X0,/PROGRAM/CCP1  IF NON-SHARED DEVICE
          TPL    X2,(/ISD/STB3,ISD,/MONITOR/HNG1)  IF *SLTS*
          TEQ    (/ISD/STB4,ISD,/PROGRAM/CCP1)  CLEAR DEVICE INTERLOCK
 
*         UPDATE TABLES.
 
          SUBFUN STBM,(UTRS,UITS)
          LX2    -1
          UX4,B3 X0
          PL     X2,/PROGRAM/CCP1  IF UTRS
          NZ     X4,/PROGRAM/CCP1  IF NOT ISHARED DEVICE
          SB3    B6+B3       *MRT* FWA
          TEQ    (/ISD/SMU,ISD,/MONITOR/HNG1)  UPDATE ISHARED TABLES
 
*         INCREMENT / DECREMENT DEVICE PF COUNT.
 
          SUBFUN STBM,(IPAS,DPAS)
          SX2    X2-IPAS
          NZ     X2,STB4     IF NOT INCREMENT
          MX1    2
          SX4    B1
          LX1    42-59
          BX7    X1*X3
          NZ     X7,/PROGRAM/CCP1  IF INTERLOCKED OR OVERFLOW
          SA2    A3+DULL-TDGL  READ LOCAL COUNT
          LX4    36
          BX7    X1*X2
          NZ     X7,HNG1     IF LOCAL INTERLOCK OR OVERFLOW
          EQ     STB5        PERFORM INCREMENT
 
 STB4     MX1    6
          SX4    -B1
          LX1    41-59
          BX7    X1*X3
          ZR     X7,HNG1     IF NO GLOBAL COUNT SET
          SA2    A3+DULL-TDGL  READ LOCAL COUNT
          LX4    36
          BX7    X1*X2
          ZR     X7,HNG1     IF NO LOCAL COUNT
 STB5     IX6    X3+X4       INCREMENT GLOBAL COUNT
          SA6    A3
          IX6    X2+X4       INCREMENT LOCAL COUNT
          SA6    A2
          EQ     /PROGRAM/CCP1  CLEAR MST INTERLOCK
 
*         SET / CLEAR UTILITY INTERLOCK.
 
          SUBFUN STBM,(SPIS,CPIS)
          SX0    X2-SPIS     0 = SET, 1 = CLEAR UTILITY INTERLOCK
          SB4    42
 STB6     SX1    B1
          LX0    B4
          LX1    B4
          BX7    -X3*X0
          NZ     X7,HNG1     IF CLEARING CLEARED INTERLOCK
          SA2    A3+DULL-TDGL
          BX6    X1-X3
          NZ     X0,STB7     IF CLEARING INTERLOCK
          BX7    X1*X3
          SB3    42
          NZ     X7,/PROGRAM/CCP1  IF INTERLOCK PREVIOUSLY SET
          NE     B4,B3,STB7  IF NOT *SPIS* SUBFUNCTION
          MX7    7
          LX7    42-59
 STB7     BX7    X7*X3
          SA6    A3
          BX6    X2-X1
          SA6    A2
          EQ     /PROGRAM/CCP1  CLEAR MST INTERLOCK
 
*         INSTALL INTERLOCK PROCESSING.
 
          SUBFUN STBM,(SIIS,CIIS)
          SX0    X2-SIIS     0 = SET INSTALL INTERLOCK
          SB4    43
          EQ     STB6        SET / CLEAR INTERLOCK
 
*         DEVICE VERIFICATION INTERLOCK PROCESSING.
 
          SUBFUN STBM,(SVIS,CVIS)
          SX0    X2-SVIS     0 = SET VERIFICATION INTERLOCK
          SB4    46
          EQ     STB6        SET / CLEAR INTERLOCK
 
*         SET OFFLINE UNIT NUMBER (*DAS* PARITY DEVICE).
*         SET REMAINING CYLINDERS / 100B (*DAS* PARITY RESTORE).
 
          SUBFUN STBM,(SOUS,SRCS)
          MX7    54
          BX6    X7*X1
          NZ     X6,HNG      IF PARAMETER VALUE TOO LARGE
          LX7    36
          LX1    36
          LX2    -1
          NG     X2,STB8     IF *SRCS* SUBFUNCTION
          LX7    6
          LX1    6
 STB8     SA4    A3+ACGL-TDGL  READ MST WORD
          BX6    X7*X4       CLEAR OLD VALUE
          BX6    X6+X1       SET NEW VALUE
          SA6    A4          STORE MST WORD
          MX7    0
          EQ     /PROGRAM/CCP1  EXIT
 TDAM     SPACE  4,25
***       TDAM - TRANSFER DATA TO/FROM JOB - FROM TO MESSAGE BUFFER.
*         IF TRANSFER TO JOB THE FIRST WORD BEING TRANSFERRED TO
*         MUST BE 0.
*
*         ENTRY
*T, OR    12/ TDAM,9/0,1/T,1/C,1/R,12/ SID,6/ WC,18/ ADDRESS
*         T = 1, INCREMENT TAPE ACTIVITY IF WRITE COMPLETE.
*         C = 1, SET COMPLETION BIT SPECIFIED BY *ADDRESS*.
*         R = 0 IF READ DATA FROM SUBSYSTEM FL TO PP MESSAGE BUFFER.
*           = 1 IF WRITE DATA FROM PP MESSAGE BUFFER TO SUBSYSTEM FL.
*         SID = SUBSYSTEM IDENTIFICATION.
*         WC = NUMBER OF WORDS TO TRANSFER.
*            = REPLY CODE IF COMPLETION BIT OPTION SELECTED (*C*=1).
*         ADDRESS = RELATIVE ADDRESS OF RECEIVING BUFFER.
*                 = 0, SPECIAL SUBSYSTEM RECEIVING BUFFER USED (SSCR).
*
*         EXIT
*T, OR    12/ 0, 12/ ST, 12/ EJTO, 24/ JSN
*         ST = 0, OPERATION COMPLETE.
*         ST = 1, MOVE IN PROGRESS.
*         ST = 2, NOT READY FOR DATA.
*         ST = 3, REJECT (WRITE REQUEST TO NON-ZERO FIRST WORD)
*         ST = 4, INACTIVE OR JOB ADVANCE SET.
*         ST = 5, SCP INVALID PARAMETERS.
*         EJTO = EJT ORDINAL OF SCP IF *ST* = 5.
*         JSN = JOB SEQUENCE NUMBER OF SCP IF *ST* = 5.
*
*         HANG CONDITIONS -
*                SPECIAL BUFFER OR SET COMPLETE BIT SPECIFIED AND SCP
*                  FACILITY NOT ENABLED.
*                INCORRECT WORD COUNT.
*                LAST WORD TO BE TRANSFERED NOT IN SUBSYSTEM FL.
*                OVERFLOW INCREMENTING TAPE ACTIVITY.
 
 
          PPR    TDAM
 
          LX1    -36
          SB3    TDA1        *RSC* RETURN ADDRESS
          MX0    -12
          SX7    B1          PRESET STORAGE MOVE - JOB ADVANCE STATUS
          SX4    X1          FLAGS
          LX1    12
          SB5    X5          SUBSYSTEM ADDRESS
          LX7    36
          BX1    -X0*X1      SUBSYSTEM IDENTIFICATION
          EQ     RSC         RETURN SUBSYSTEM LOCATION
 
*         *RSC* EXIT ADDRESSES.
 
          VFD    12/TDA3-TDA1,18/HNG,12/TDA3-TDA1,18/PPR1
 
 TDA1     SX1    ICAN
          IX1    X3-X1
          ERX1   X1          GET INTER-CONTROL POINT COMMUNICATION WORD
          SB4    X4-2        CHECK FOR SET COMPLETION BIT ONLY
          SB3    X6          SUBSYSTEM FL
          LX7    1           SET NOT READY STATUS
          TZR    B5,(/MONITOR/SSR,SCP,/MONITOR/HNG)  IF SPECIAL BUFFER
          TZR    B4,(/MONITOR/SCB,SCP,/MONITOR/HNG)  IF SET COMPLETION
          AX5    6
          PL     X1,PPR1     IF NOT READY TO RECEIVE DATA
          SX5    X5
          SB3    X6          (B4) = SUB-SYSTEM FL
          AX5    12          (X5) = WORD COUNT
          SX0    B5          RELATIVE ADDRESS TO X0
          IX0    X0+X3       ABSOLUTE SUB SYSTEM ADDRESS
          SX1    X5-7        CHECK FOR LEGAL WORD COUNT
          SX5    X5-1
          BX1    -X5*X1
          SB6    B5+X5
          PL     X1,HNG      IF ILLEGAL WORD COUNT
          GE     B6,B3,HNG   IF OUTSIDE SUB-SYSTEM FL
          SX1    A5+1        MESSAGE BUFFER ADDRESS
          AX6    X7,B1
          SB4    X5+1        WORD COUNT
          IX1    X0-X1       DIFFERENCE
          ZR     X4,TDA2     IF READ
          SX0    A5+B1       REVERSE TRANSFER
          IX7    X6+X7       SET REJECT STATUS
          IX3    X0+X1       SUB SYSTEM BUFFER
          ERX3   X3
          MX6    60
          BX1    X6-X1       COMPLEMENT DIFFERENCE
          NZ     X3,PPR1     IF NON-ZERO FIRST WORD
          NG     X3,PPR1     IF NON-ZERO FIRST WORD
 
*         DATA TRANSFER LOOP.
 
 TDA2     SB6    TDA2.2      *MSR* RETURN
          SX2    X4+         SAVE FLAGS
          TNO    /CME/MSR,CME
          SB6    X1+
 TDA2.1   SB4    B4-B1       DECREMENT WORD COUNT
          SA3    X0+B4
          BX7    X3
          SA7    A3-B6
          NZ     B4,TDA2.1   IF MORE TO MOVE, CONTINUE
 TDA2.2   BX7    X7-X7       SET COMPLETION STATUS
          ZR     X2,PPR1     IF READ - EXIT TO STORE OUTPUT REGISTER
          LX2    59-2
          PL     X2,TDA2.3   IF NOT TO INCREMENT TAPE ACTIVITY
          SA1    B7+STSW
          SX0    360B
          SX6    20B
          BX2    X0*X1       CURRENT TAPE/RECALL ACTIVITY
          IX6    X1+X6       INCREMENT TAPE ACTIVITY
          IX2    X0-X2
          ZR     X2,HNG      IF ACTIVITY ALREADY AT MAXIMUM
          SA6    A1+         UPDATE TAPE ACTIVITY
 
*         ENTRY FROM *SSR* TO START SUB-SYSTEM EXECUTIVE.
 
 TDA2.3   SA1    A2+CWQW-STSW  GET RECALL STATUS
          SA7    A5          STORE OUTPUT REGISTER
          LX1    59-46
          SB6    A2-STSW     SET JOB EXCHANGE PACKAGE ADDRESS
          NG     X1,PPRX     IF NOT TO RECALL CPU
          SB3    PPRX        *RCC* RETURN ADDRESS
          EQ     RCC         RECALL CPU
 
*         EXIT FOR SCP NOT ACTIVE.  (ALSO ENTERED HERE FROM *SSR*.)
 
 TDA3     SX7    B1          RETURN STATUS 4
          LX7    36+2
          EQ     PPR1
 TDRM     SPACE  4,25
***       TDRM - INTERLOCK TAPE DRIVER REQUEST.
*
*         ENTRY
*T, OR    12/  TDRM,12/ UDTA,10/,1/B,25/
*
*         UDTA   UDT ADDRESS
*         B      UNIT BUSY STATUS.
*
*         EXIT
*T, OR    12/  0,48/,12/ STATUS
*T, MB    60/ FTAB
*T, MB+1  60/ ASCM
*
*         STATUS 1 = REQUEST IN PROGRESS SET.
*                0 = NO DRIVER REQUEST PRESENT, REQUEST ALREADY IN
*                    PROGRESS OR COMPLETE, OR REQUEST REQUEUED.
*         FTAB   *1MT* FUNCTION TABLE ENTRY IF REQUEST IN PROGRESS SET.
*         ASCM   *ASCM* FUNCTION TO LOAD FIRST *1MT* OVERLAY IF REQUEST
*                  IN PROGRESS SET AND PLD NOT LOCKED.
*                0 IF REQUEST IN PROGRESS SET AND PLD INTERLOCKED.
*
*         HANG CONDITIONS -
*                CALLING PP NOT ASSIGNED TO MAGNET CP.
*                INCORRECT UDT ADDRESS.
 
 
          PPR    TDRM
 
          SA2    B7+JCIW
          SA4    B7+FLSW
          AX1    36          SET UDT ADDRESS
          MX0    -12
          ZR     X1,HNG      IF NO UDT ADDRESS
          LX2    -24
          BX6    -X0*X4
          BX2    -X0*X2      SUBSYSTEM ID
          LX6    6           FL
          MX0    -RMSK
          LX4    -RSHF
          SX6    X6-/MTX/UNITL
          BX4    -X0*X4
          SX2    X2-MTSI
          LX4    6           RA
          NZ     X2,HNG      IF NOT CALLED BY MAGNET
          IX6    X1-X6
          IX3    X4+X1       UDT ABSOLUTE ADDRESS
          PL     X6,HNG      IF UDT ENTRY NOT IN FL
          ERX1   X3          GET *UXRQ*
          ERRNZ  /MTX/UXRQ
          MX0    12
          BX0    X0*X1       REQUEST STATUS
          NZ     X0,PPR1     IF REQUEST ALREADY IN PROGRESS OR COMPLETE
          LX1    -36
          MX0    -6
          BX2    -X0*X1      REQUEST CODE
          SX6    X2-/MTX/MDFN
          PL     X6,PPR1     IF NOT *1MT* REQUEST
          SX6    X2+/MTX/TFUN-1
          ZR     X2,PPR1     IF NO REQUEST
          IX6    X4+X6       FUNCTION TABLE ENTRY ABSOLUTE ADDRESS
          LX5    53-25
          ERX2   X6          READ FUNCTION TABLE ENTRY
          BX5    X5*X2       BUSY STATUS .AND. REQUEUE ON UNIT BUSY
          LX5    59-53
          LX0    6
          PL     X5,TDR2     IF NOT TO REQUEUE REQUEST
 
*         REQUEUE REQUEST.
 
          SX2    100B
          BX4    -X0*X1      COUNT OF REQUEUES WITHOUT DELAY
          IX6    X1+X2       INCREMENT REQUEUES WITHOUT DELAY
          SX4    X4-7700B
          BX1    X0*X1       CLEAR REQUEUE COUNT
          ZR     X4,TDR1     IF MAXIMUM REQUEUES WITHOUT DELAY
          LX6    36
          EWX6   X3          UPDATE *UXRQ*
          EQ     PPR1        EXIT TO SET OUTPUT REGISTER
 
 TDR1     SX6    /MTX/RBS
          LX1    36
          LX6    48
          BX6    X6+X1       SET REQUEUE ON UNIT BUSY
          EWX6   X3          UPDATE *UXRQ*
          EQ     PPR1        EXIT TO SET OUTPUT REGISTER
 
*         SET REQUEST IN PROGRESS.
 
 TDR2     BX1    X0*X1       CLEAR REQUEUE COUNT
          SX6    /MTX/RIP
          LX1    36
          LX6    48
          BX7    X2
          BX6    X1+X6       SET REQUEST IN PROGRESS
          SA7    A5+B1       SET FUNCTION TABLE ENTRY
          EWX6   X3          UPDATE *UXRQ*
          MX0    6
          SX6    2L3M
          BX2    X0*X2       OVERLAY NAME THIRD CHARACTER
          LX6    42
          LX2    -12
          BX6    X6+X2       SET OVERLAY NAME
          SB6    TDR3        SET RETURN ADDRESS
          EQ     SPL         SEARCH FOR OVERLAY
 
 TDR3     SX6    B0
          R=     X2,ASCM
          NG     X1,TDR4     IF LIBRARY LOCKED
          NZ     X5,TDR4     IF OVERLAY NOT FOUND
          LX2    48
          BX6    X2+X7       SET *ASCM* PARAMETERS
 TDR4     SX7    1           INDICATE REQUEST IN PROGRESS SET
          SA6    A5+2        SET OVERLAY PARAMETERS
          EQ     PPR1        EXIT TO SET OUTPUT REGISTER
 TGPM     SPACE  4,20
**        TGPM - PROCESS REQUEST FOR *IAF* POT CHAIN
*
*         A POT POINTER IS TAKEN OUT OF ONE OF THE *TGPM* QUEUES
*         IN *IAF*.  THIS POT POINTER IS RETURNED IN THE OUTPUT
*         REGISTER.  IF THERE IS NO POT POINTER IN THE QUEUE, AN
*         ERROR COUNTER IS INCREMENTED AND A REJECT IS RETURNED.
*         IF *IAF* IS UNACCESSIBLE OR ERROR FLAGS ARE SET, THE
*         OUTPUT REGISTER IS CLEARED.
*
*         ENTRY
*T,OR     12/  TGPM, 12/  PCL, 36/  0.
*         PCL    POT CHAIN LENGTH.
*
*         EXIT
*T,OR     12/  0, 12/  PP, 36/  0.
*         PP     7777, IF NO POTS ARE AVAILABLE,
*                0, IF *IAF* IS INACCESSIBLE OR ERROR FLAGS ARE SET,
*                ELSE, THE POT POINTER.
 
 
          PPR    TGPM
 
          SB3    TGP1
          EQ     CIA         CHECK *IAF* ACCESSIBILITY
 
 TGP1     SA2    VCPT*200B+FLSW
          NZ     B4,PPR1     IF *IAF* INACCESSIBLE OR ERROR FLAG SET
          SA3    TGPA        GET SHORT POT CHAIN POINTER
          MX0    -RMSK
          AX1    36
          AX2    RSHF
          SB4    X1-VSCL-1
          BX2    -X0*X2
          LX2    6           (X2) = REFERENCE ADDRESS
          PL     B4,TGP5     IF LONG POT CHAIN NEEDED
          SB4    -VTLP       GET SHORT POT CHAIN QUEUE LIMIT
          SX5    VTSP
 TGP2     IX7    X3+X2
          ERX4   X7
          ZR     X4,TGP6     IF NO POT IN *TGPM* QUEUE
          BX6    X6-X6
          EWX6   X7          CLEAR QUEUE ENTRY
          SX6    X3+1        INCREMENT QUEUE POINTER
          SB4    X6+B4
          NG     B4,TGP4     IF LIMIT
          BX6    X5          RESET TO BEGINNING OF QUEUE
 TGP4     SA6    A3+
          LX4    36
          BX7    X4
          EQ     PPR1        RETURN POT POINTER
 
 TGP5     SA3    TGPB        GET LONG POT CHAIN POINTER
          SX5    VTLP
          SB4    -VTEQ       GET LONG POT CHAIN QUEUE LIMIT
          EQ     TGP2        CONTINUE
 
 TGP6     SX5    VTGR        COUNT NO POT AVAILABLE
          IX5    X2+X5
          ERX2   X5
          MX7    12          SET ERROR RESPONSE
          SX6    B1
          LX7    -12
          IX6    X6+X2
          EWX6   X5
          EQ     PPR1        RETURN ERROR
 
 
 TGPA     CON    VTSP        SHORT POT CHAIN QUEUE POINTER
 TGPB     CON    VTLP        LONG POT CHAIN QUEUE POINTER
 TIOM     SPACE  4,30
***       TIOM - TAPE I/O PROCESSOR.
*
*         UPDATES TAPE ACCOUNTING.
*         THE PP IS CHANGED TO *MAGNET,S* CONTROL POINT.
*         IF COMPLETION CODE .NE. 0, THE SPECIFIED UDT WORD IS CLEARED
*         THE FET IS COMPLETED, AND THE ACTIVITY COUNT IS DECREMENTED.
*
*         ENTRY
*T, OR    12/ TIOM,12/ UDT,1/W,11/ AI,6/ AM,18/ CC
*         UDT    UNIT DESCRIPTOR TABLE ADDRESS.
*         W      READ/WRITE INDICATOR (0 = READ, 1 = WRITE).
*         AI     ACCOUNTING INCREMENT.
*         AM     ACCOUNTING MULTIPLIER.
*                  IF NON-ZERO, AI*AM IS APPLIED TO MT ACCUMULATOR.
*                  IF ZERO, AI IS APPLIED TO MT ACCUMULATOR.
*         CC     FET COMPLETION CODE IF COMPLETING CIO REQUEST.  IF
*                  ZERO, THE FET AND FST WILL NOT BE SET COMPLETE AND
*                  THE TAPE ACTIVITY WILL NOT BE DECREMENTED.  NOTE
*                  THAT A NON-ZERO VALUE MUST BE SPECIFIED ON A TAPE
*                  RETURN REQUEST TO CAUSE THE TAPE ACTIVITY TO BE
*                  DECREMENTED.
*
*         EXIT
*T, OR    12/  0,48/ (UNCHANGED)
*
*         HANG CONDITIONS -
*                MAGNET NOT PRESENT OR NOT ACCESSIBLE.
*                INCORRECT UDT ADDRESS.
*                NO TAPE ACTIVITY PRESENT.
*                INCORRECT FET ADDRESS.
 
 
          PPR    TIOM
 
*         CHECK MAGNET STATUS.
 
          SX1    MTSI        SET MAGNET SUBSYSTEM ID
          SB5    PPRX        SET *REJ* RETURN ADDRESS
          SB3    TIO1        SET *RSC* NORMAL RETURN ADDRESS
          SX0    -7777B
          EQ     RSC         CHECK MAGNET STATUS
 
*         VALIDATE UDT ADDRESSES AND TAPE ACTIVITY.
 
          VFD    12/HNG-TIO1,18/HNG,12/HNG-TIO1,18/REJ
 
 TIO1     SA1    B7+STSW
          SB3    X5          SAVE FET STATUS
          LX5    -36
          BX2    -X0*X5
          SX2    X2+/MTX/UBLC  *UBLC* RELATIVE ADDRESS
          IX6    X2-X6
          IX4    X3+X2       *UBLC* ABSOLUTE ADDRESS
          PL     X6,HNG      IF UDT WORDS NOT IN MAGNET FL
          ERRNG  /MTX/UBLC-/MTX/UFRQ  VALIDATE *UFRQ* IN FL
          ERRNG  /MTX/UBLC-/MTX/UCIA  VALIDATE *UCIA* IN FL
          ERX3   X4          READ *UBLC*
          SX6    360B
          BX6    X6*X1
          MX7    11
          ZR     X6,HNG      IF NO TAPE ACTIVITY PRESENT
 
*         UPDATE BLOCK COUNT IN UDT.
 
          LX7    -1
          BX6    X7*X5       BLOCKS TRANSFERRED
          LX6    -12
          PL     X5,TIO2     IF UPDATING BLOCKS READ
          LX6    -24
 TIO2     IX6    X3+X6       COUNT BLOCKS READ OR WRITTEN
          EWX6   X4          UPDATE *UBLC*
          ZR     B3,TIO4     IF NOT COMPLETING REQUEST
 
*         DECREMENT TAPE ACTIVITY AND CHECK REQUEST TYPE.
 
          SX6    /MTX/UBLC-/MTX/UFRQ
          IX4    X4-X6       *UFRQ* ABSOLUTE ADDRESS
          ERX3   X4          READ *UFRQ*
          SX6    20B
          IX6    X1-X6       DECREMENT TAPE ACTIVITY
          SA6    A1
          BX2    -X0*X3      *CIO* REQUEST FNT ADDRESS
          ZR     X3,HNG      IF NO REQUEST
          SX6    B0
          AX3    48
          EWX6   X4          CLEAR *UFRQ*
          SX3    X3-/MTX/CIO
          SX6    /MTX/UCIA-/MTX/UFRQ
          NZ     X3,TIO8     IF NOT *CIO* REQUEST
 
*         VERIFY FNT AND FET ADDRESS.
 
          SA1    B7+FLSW
          IX4    X4+X6       *UCIA* ABSOLUTE ADDRESS
          ERX3   X4          READ *UCIA*
          MX7    -18
          BX6    -X0*X1      FL/100B
          LX1    -48
          BX3    -X7*X3      RELATIVE FET ADDRESS
          BX4    -X0*X1      NFL/100B
          SB4    X3+         RELATIVE FET ADDRESS
          LX6    6           FL
          LX4    6           NFL
          SB5    X6+         FL
          IX4    X2-X4
          LE     B4,B1,HNG   IF INCORRECT FET ADDRESS
          PL     X4,HNG      IF FNT ADDRESS NOT IN NFL
 
*         SET FST COMPLETE.
 
          LX1    36
          MX6    -RMSK
          SX2    X2-FSTL     RELATIVE FST ADDRESS
          BX6    -X6*X1
          LX6    6           RA
          IX2    X6-X2       ABSOLUTE FST ADDRESS
          IX3    X6+X3       ABSOLUTE FET ADDRESS
          ERX1   X2          READ FST
          SX6    B1
          BX6    X1+X6       SET FST COMPLETE
          LX1    -36
          BX1    X5-X1
          BX1    -X0*X1
          NZ     X1,HNG      IF INCORRECT UDT ADDRESS IN FST
          EWX6   X2          UPDATE FST
          GE     B4,B5,TIO4  IF FET ADDRESS NOT IN FL
 
*         SET FET STATUS.
 
          ERX1   X3          READ FET STATUS
          SX2    B3+
          MX6    -16
          BX2    -X7*X2      COMPLETION STATUS
          EQ     B3,B1,TIO3  IF NORMAL COMPLETION
          LX6    2
          BX1    X6*X1       CLEAR STATUS FLAGS
 TIO3     BX6    X1+X2       MERGE COMPLETION STATUS
          EWX6   X3          UPDATE FET STATUS
 
*         UPDATE ACCOUNTING.
 
 TIO4     SA3    B7+IOAW
          LX5    -48
          MX1    -11
          BX1    -X1*X5      AI
          LX5    6
          ZR     X1,TIO7     IF NO ACCOUNTING INCREMENT
          MX7    -6
          SB4    B0+         SET NO OVERFLOW
          BX7    -X7*X5      AM
          MX6    20
          ZR     X7,TIO5     IF AM NOT SPECIFIED
          IX1    X7*X1
 TIO5     LX3    -20         POSITION TAPE ACCUMULATOR
          LX6    20
          BX4    X6*X3       OLD VALUE
          IX4    X4+X1       ADD INCREMENT
          BX3    -X6*X3      CLEAR OLD VALUE
          IX7    X4-X6
          NG     X7,TIO6     IF NO OVERFLOW
          SB4    4           SET MT ACCUMULATOR OVERFLOW
          IX4    X4-X6       REMOVE OVERFLOW
 TIO6     BX6    X3+X4       MERGE NEW VALUE
          SB3    TIO7        SET *AIO* RETURN ADDRESS
          LX6    20
          SX2    B1          SET TAPE ACCUMULATOR
          SA6    A3          UPDATE TAPE ACCUMULATOR
          EQ     AIO         UPDATE SRU ACCUMULATOR
 
*         RECALL CPU.
 
 TIO7     SA1    B7+CWQW     CHECK RECALL STATUS
          SB6    B7          SET EXCHANGE PACKAGE ADDRESS
          LX1    59-46
          NG     X1,TIO8     IF NOT TO RECALL CPU
          SB3    TIO8        *RCC* RETURN ADDRESS
          EQ     RCC         RECALL CPU
 
*         RETURN TO MAGNET CONTROL POINT.
 
 TIO8     TX2    A5-1,-FP
          SX1    ALCS
          LX2    PPXES-PPCES
          LX1    36          SET ALTERNATE CP FLAG
          TA2    X2+ACPP,FPX GET *ACPP*
          SB3    CCAM-1777B
          PX6    B3,X1
          BX5    X1
          SA6    A5          SET *CCAM* REQUEST IN OUTPUT REGISTER
          EQ     .CCAM       CHANGE CONTROL POINT
 TRCM     SPACE  4,35
**        TRCM - PROCESS TRAP/TRACE REQUEST.
*
*         UPDATE TRAP/TRACE CONTROL WORDS IN THE TRACE BLOCK.
*
*         ENTRY
*T,OR     12/ TRCM,12/ FLAGS,12/ 0,24/ WD1.
*T,MB+0   12/ 0,24/ WD2,24/ WD3.
*T,MB+0   12/ FN1,12/ FN2,12/ FN3,12/ FN4,12/ FN5.
*T,MB+0   30/ 0,6/ LEN,18/ 0,6/ LOW.
*T,MB+1   60/ VALUE.
*
*         FLAGS -
*                BIT 47 SET IF *TRAP,MEM*.
*                BIT 46 SET IF *TRAP,CPA*.
*                BIT 45 SET IF *TRAP,NFL*.
*                BIT 44 SET IF *TRAP,MCT*.
*                BIT 43 SET IF *TRAP,DJB*.
*                BIT 42 SET IF *TRAP,EJT*.
*                BIT 41 SET IF TRAPPING ON ANY NONZERO VALUE.
*                BIT 40 SET IF *TRACE,MTR*.
*                BIT 39 SET IF *TRACE,PPU*.
*                BIT 38 SET IF *TRACE,SET,ABS*.
*                BIT 37 SET IF *TRACE,SET,CPA*.
*
*         WD1 = ABSOLUTE ADDRESS OF WORD TO TRAP ON (*TRAP,MEM*).
*             = ADDRESS IN CPA OF WORD TO TRAP ON (*TRAP,CPA*).
*         WD2, WD3 = ABS OR CPA ADDRESSES TO TRACE (*TRACE,SET*).
*         FN1 - FN5 = FUNCTIONS TO TRACE FOR *TRACE,MTR/PPU*.
*         LEN = LENGTH OF FIELD TO CHECK FOR *TRAP,MEM/CPA*.
*         LOW = LOW BIT OF FIELD TO CHECK FOR *TRAP,MEM/CPA*.
*         VALUE = VALUE TO CHECK AGAINST FOR *TRAP,MEM/CPA*.
 
 
          PPR    TRCM,(/TRACE/TRC,TRACE,/MONITOR/HNG)
 TSEM     SPACE  4,20
**        TSEM - PROCESS *IAF* REQUEST.
*
*         THE *IAF REQUEST IS PUT IN THE *IAF* *TSEM* QUEUE.
*         IF THERE IS NO AVAILABLE QUEUE ENTRY FOR THE REQUEST,
*         AN ERROR COUNTER IS INCREMENTED AND A REJECT IS RETURNED.
*         IF *IAF* IS INACCESSIBLE OR ERROR FLAGS ARE SET, THE OUTPUT
*         REGISTER IS CLEARED.
*
*         ENTRY
*T,OR     12/  TSEM,48/  .
*T,MB     60/  *IAF* REQUEST.
*
*         EXIT
*T,OR     12/  0, 12/  FLAG, 36/  0.
*         FLAG   0, IF *IAF* IS INACCESSIBLE OR ERROR FLAGS ARE SET,
*                .NE. 0, IF REQUEST COMPLETE.
*                7777, IF NO AVAILABLE QUEUE ENTRY.
*
*         IF THE REQUEST IS INVALID, THE SYSTEM WILL HANG.
 
 
          PPR    TSEM
 
          SB3    TSE1        SET RETURN ADDRESS
          EQ     CIA         CHECK *IAF* ACCESSIBILITY
 
 TSE1     SA3    A5+1
          BX7    X3
          AX3    48
          NZ     B4,TSE4     IF IAF INACCESSIBLE OR ERROR FLAG SET
          NG     X3,TSE4     IF IAF GOING DOWN
          SB4    X3-2000B
          NG     B4,HNG      IF INVALID *TSEM* REQUEST
          SB4    X3-VMXR
          PL     B4,HNG      IF INVALID *TSEM* REQUEST
          SA2    VCPT*200B+FLSW
          SA1    TSEA        GET *TSEM* QUEUE POINTER
          MX0    -RMSK
          AX2    RSHF
          BX2    -X0*X2
          LX2    6           (X2) = REFERENCE ADDRESS
          IX6    X1+X2
          ERX4   X6
          SB4    X1+1-VTSP
          NZ     X4,TSE3     IF QUEUE ENTRY NOT AVAILABLE
          EWX7   X6          PASS ENTRY TO *IAF*
          SX6    X1+B1
          NG     B4,TSE2     IF NOT AT LIMIT
          SX6    VTRP        RESET TO BEGINNING OF QUEUE
 TSE2     SA6    A1
          AX7    12          SET REQUEST COMPLETE
          EQ     PPR1        RETURN NON-ZERO STATUS
 
 TSE3     SX5    VTSR        COUNT UNAVAILABLE ENTRY
          IX5    X2+X5
          ERX2   X5
          MX7    12
          SX6    B1
          LX7    -12
          IX6    X6+X2       INCREMENT ERROR COUNT
          EWX6   X5
          EQ     PPR1        RETURN ERROR CODE
 
 TSE4     SX7    B0
          PL     X3,PPR1     IF NOT A SPECIAL REQUEST
          MX7    1
          NZ     X3,TSE5     IF NOT *7777* REQUEST TO SET ACCESSIBILITY
          SX6    VTSP
          BX7    X2+X7       SET IAF ACCESSIBILITY BIT
          SA7    A2
          SA6    TGPA        RESET QUEUE POINTERS
          SX7    VTRP
          SX6    VTLP
          SA7    TSEA
          SA6    TGPB
          MX7    1
          LX7    -12
          EQ     PPR1        RETURN NON-ZERO STATUS
 
 TSE5     BX6    -X7*X2      CLEAR IAF ACCESSIBILITY BIT
          SX7    X3+B1
          NZ     X7,HNG      IF NOT *7776* REQUEST
          SA6    A2
          EQ     PPR1        RETURN
 
 
 TSEA     CON    VTRP        *TSEM* QUEUE POINTER
 UADM     SPACE  4
***       UADM - UPDATE CONTROL POINT AREA.
*
*         ENTRY
*T,OR     12/  UADM,12/  CT,10/,1/  RF,1/  DF,12/,12/
*
*T,MB     12/  SF,12/  AD,6/  P,6/  W,6/,18/INC
*T,MB+1   12/  SF,12/  AD,6/  P,6/  W,6/,18/INC
*          .
*          .
*          .
*T,MB+CT-1 12/  SF,12/  AD,6/  P,6/  W,6/,18/INC
*
*         NOTE - REQUESTS ARE PROCESSED IN REVERSE ORDER.
*
*         CT     NUMBER OF REQUESTS IN MESSAGE BUFFER
*         RF     SET IF CPU TO BE RECALLED TO CONTROL POINT
*         DF     DROP FLAG   0 = DROP
*                            1 = NO DROP
*
*         SF     SUBFUNCTION CODE AS DEFINED IN COMSCPS
*                CICS  INCREMENT CONTROL POINT FIELD
*                CIOS  INCREMENT CONTROL POINT FIELD BY ONE
*                CDOS  DECREMENT CONTROL POINT FIELD BY ONE
*                CDCS  DECREMENT CONTROL POINT FIELD
*                LICS  INCREMENT LOW CORE FIELD
*                LIOS  INCREMENT LOW CORE FIELD BY ONE
*                LDOS  DECREMENT LOW CORE FIELD BY ONE
*                LDCS  DECREMENT LOW CORE FIELD
*                AISS  ACCOUNTING INCREMENT - IO
*                AIAD  ACCOUNTING INCREMENT - ADDER
*                AIMP  ACCOUNTING INCREMENT - MP
*                CSFS  SET CONTROL POINT FIELD
*                FRAS  ADJUST *FRC*-BASED VALUES IN *CPUMTR*
*
*         AD     ADDRESS OF WORD IN CP/LOW CORE
*         P      LOW ORDER BIT POSITION OF FIELD TO UPDATE
*         W      WIDTH OF FIELD TO UPDATE
*         INC    18 BIT POSITIVE VALUE TO INCREMENT/DECREMENT/SET
*
*         FOR *FRAS* SUBFUNCTION -
*
*T,MB+N   12/ FRAS, 48/ DESIRED *FRC* VALUE
*
*         THE CPU START TIME(S) AND THE WALL CLOCK BASES ARE ADJUSTED
*         BY THE DIFFERENCE BETWEEN THE DESIRED AND CURRENT VALUES OF
*         THE FREE-RUNNING COUNTER.  THE REQUESTING PP-S OUTPUT
*         REGISTER IS CLEARED IMMEDIATELY, ALTHOUGH THE MONITOR
*         FUNCTION DOES NOT COMPLETE UNTIL THE FREE-RUNNING COUNTER IS
*         UPDATED (BY *DFT*).  THIS IS NECESSARY TO ENSURE THAT NO
*         USER JOB IS CHARGED (OR TIME LIMITED) WHEN THE MICROSECOND
*         CLOCK IS ADVANCED BY AS MUCH AS DAYS, WEEKS, OR MONTHS.
*         NOTE THAT THE DROP-PP OPTION AND ANY FURTHER REQUESTS ARE
*         IGNORED.
*
*         EXIT
*T,OR     12/,12/  STAT,12/,12/,12/
*         STAT   NON-ZERO IF OVERFLOW/UNDERFLOW
*                BITS INDICATE WHICH REQUESTS GAVE OVERFLOW/UNDERFLOW
*                BIT 0 = MB
*                BIT 1 = MB+1  ETC
*
*         THE FOLLOWING DESCRIBES THE ACTION TAKEN WHEN OVERFLOW/
*         UNDERFLOW OCCURS.
*
*         UPDATE OPTION      ACTION TAKEN
*         LOW CORE           LEAVE FIELD ALONE.
*         CONTROL POINT      INCREMENT TO MAXIMUM VALUE - 1.
*                            DECREMENT TO ZERO ON UNDERFLOW.
*         SRU UPDATES        INCREMENT TO OVERFLOW VALUE - MAXIMUM
*
*         IF ALL THE BITS ARE SET IN THE FIELD BEFORE THE UPDATE AND
*         THE FIELD WIDTH IS GREATER THAN ONE BIT, THE UPDATE OPTION
*         IS IGNORED.  IF ALL THE BITS IN THE FIELD ARE SET AS A
*         RESULT OF THE UPDATE, AN OVERFLOW CONDITION IS RETURNED.
*
*         *PP HUNG.* WILL OCCUR FOR THE FOLLOWING CONDITIONS.
*         1)     TOO MANY REQUESTS.
*         2)     CONTROL POINT UPDATE AND ADDRESS NOT BETWEEN
*                *STSW* AND *CSBW*.
*         3)     LOW CORE UPDATE AND ADDRESS IS .GE. *CRTL*.
*         4)     ILLEGAL SUBFUNCTION.
*         5)     REQUEST COUNT = 0 AND NOT DROP PP OPTION.
 
 
          PPR    UADM
 
          LX1    59-25
          PL     X1,UAD0     IF NO RECALL OF THE CPU
          SA3    B7+CWQW     CHECK RECALL STATUS
          SB6    B7          SET EXCHANGE PACKAGE ADDRESS
          LX3    59-46
          SB3    UAD0        SET *RCC* RETURN ADDRESS
          PL     X3,RCC      IF TO RECALL CPU
 UAD0     UX1    X5
          LX1    59-35
          MX2    11
          BX1    -X2*X1      CLEAR BIT FLAGS
          SB4    6
          SB5    X1          REQUEST COUNT
          AX1    48
          ZR     B5,UAD10    IF NO REQUESTS PRESENT
          SX7    X1          DROP FLAG
          GT     B5,B4,HNG   IF TOO MANY REQUESTS
          SB3    UAD7        SET *AIO*/*AAD* RETURN
 UAD1     SA2    A5+B5       READ REQUEST
          MX0    -12
          SB5    B5-B1       DECREMENT REQUEST COUNT
          MX6    -18
          BX1    X0*X2
          LX1    9
          SB6    X1          OPTION    CODE
          AX1    58
          SB4    B6-FRAS/10B
          NZ     X1,UAD2     IF INCREMENT/DECREMENT OF 1
          TZR    B4,(/NVE/UAD,NVE,/MONITOR/HNG)  IF *FRAS* REQUEST
          BX3    -X6*X2      SET VARIABLE INCREMENT
          BX1    X1-X3       COMPLEMENT FOR DECREMENT OPTION
 UAD2     LX2    24
          BX5    -X0*X2      DETERMINE WORD ADDRESS
          MX0    -6
          LX2    12
          BX4    -X2+X0      FIELD WIDTH COMPLEMENTED
          AX2    6
          SB4    X4+59
          MX6    1
          BX2    -X0*X2      FIELD POSITION WITHIN WORD
          SX4    X5-STSW
          AX0    X6,B4       FORM COMPLEMENT OF FIELD MASK
          SX3    X5-RCCW
          BX4    -X4*X3
          NZ     B6,UAD3     IF NOT LOW CORE UPDATE
          SX4    X5-200B
          SX6    -B7         SET RELATIVE TO ZERO
          IX5    X5+X6
 UAD3     SA3    X5+B7       READ WORD TO UPDATE
          MX5    -1
          PL     X4,HNG      IF ADDRESS OUT OF RANGE
          SX6    B6-CSFS/10B CHECK SET FIELD
          BX5    X5-X0       SET 1 BIT FIELD WIDTH FLAG
          SB4    X2          FIELD POSITION WITHIN WORD
          NZ     X6,UAD4     IF NOT SET CONTROL POINT FIELD
          LX6    X0,B4       CLEAR ANY EXISTING DATA
          BX3    X6*X3
 UAD4     AX4    X3,B4       POSITION FIELD TO BOTTOM OF WORD
          BX6    X4+X0
          AX2    4
          BX4    -X0*X4      CURRENT VALUE OF FIELD
          SB6    B6-1
          ZR     X5,UAD5     IF 1 BIT FIELD WIDTH
          ZR     X6,UAD7     IF UNLIMITED
          IX6    X4+X1
          BX5    X0+X6
          ZR     X5,UAD8     IF FIELD INCREMENTED TO MAXIMUM
 UAD5     IX6    X4+X1       CURRENT VALUE + INCREMENT
          LX4    X1,B4       POSITION INCREMENT/DECREMENT VALUE
          BX5    X0*X6       ERASE FIELD
          NZ     X5,UAD8     IF OVERFLOW/UNDERFLOW
          SB4    B0
          SB6    B6-B1
 UAD6     IX6    X4+X3       INCREMENT/DECREMENT FIELD
          SA6    A3
          NG     B6,UAD7     IF NO SRU UPDATE
          ZR     B6,AIO      IF INCREMENTING IO SRU
          SB6    B6-1
          ZR     B6,AAD      IF INCREMENTING ADDER SRU
          SB6    B6-1
          ZR     B6,AMP      IF INCREMENTING MAP OR OD SRU
          SB6    B6-3
          NE     B6,B1,HNG   IF ILLEGAL OPERATION CODE
 UAD7     GT     B5,B0,UAD1  IF MORE REQUESTS
          SB6    B1+         MAKE SURE B6 IS NON-ZERO
          ZR     X7,.DPPM    IF DROP PPU
          EQ     PPR1        EXIT
 
 UAD8     SX4    X7          SET ERROR INDICATION
          LX4    X4,B5
          LX4    36
          BX7    X7+X4
          BX4    X4-X4       NO INCREMENT FOR LOW CORE UPDATE
          NG     B6,UAD6     IF LOW CORE OPTION
          SB6    B6-B1
          IX4    X6+X0       INCREMENT TO OVERFLOW VALUE - MAXIMUM
          SX6    X2
          PL     B6,UAD9     IF SRU UPDATE
          SX4    -B1
          AX5    59
          IX4    X4-X0       MAXIMUM - 1
          BX4    -X5*X4      X4 CLEARED FOR DECREMENT (UNDERFLOW)
 UAD9     LX0    X0,B4       CLEAR FIELD
          LX4    X4,B4       POSITION NEW VALUE
          BX3    X0*X3
          SB4    B1          SET PF OR ADDER OVERFLOW FLAG
          NG     B6,UAD6     IF NOT SRU UPDATE
          ZR     X6,UAD6     IF PF OR ADDER UPDATE
          LX6    2
          SB4    X6          OVERFLOW FLAG MT=4, MS=10B
          EQ     UAD6
 
 UAD10    SB6    B1+         MAKE SURE B6 IS NON-ZERO
          ZR     X1,.DPPM    IF DROP PPU SELECTED
          EQ     HNG         HANG PPU
 UTEM     SPACE  4,10
***       UTEM - UPDATE TABLE ENTRY.
*
*         ENTRY
*T,OR     12/ UTEM,6/0,1/I,1/J,1/0,3/NR,12/,24/ ADDR
*
*T,MB     1/V,5/ WI,6/ FS,6/ BP,42/ VALUE
*         .
*         .
*         .
*T,MB+NR-1 1/V,5/ WI,6/ FS,6/ BP,42/ VALUE
*
*         NR     NUMBER OF REQUESTS IN MESSAGE BUFFER.
*         I      INTERLOCK *ADDR* OPTION.
*                I = 0, NR = 0         *ADDR* INTERLOCK (BIT 0) WILL
*                                      BE SET (REJECT IF ALREADY SET
*                                      OR *ADDR* ENTRY NOT IN USE).
*                I = 0, NR .NE. 0      *NR* REQUESTS FROM MESSAGE
*                                      BUFFER WILL BE PROCESSED.
*                I = 1, NR = 0         *ADDR* INTERLOCK WILL BE
*                                      CLEARED (HANG IF INTERLOCK NOT
*                                      PREVIOUSLY SET OR *ADDR* ENTRY
*                                      NOT IN USE).
*                I = 1, NR .NE. 0      *ADDR* INTERLOCK WILL BE SET
*                                      AFTER PROCESSING *NR* REQUESTS
*                                      FROM MESSAGE BUFFER (REJECT IF
*                                      VERIFY FAILURE FROM MESSAGE
*                                      BUFFER REQUEST OR IF INTERLOCK
*                                      ALREADY SET OR *ADDR* ENTRY
*                                      NOT IN USE).
*         J      IF SET, JOB ADVANCE CHECK NEEDED ON EJT ENTRY
*                (APPLICABLE ONLY FOR *I* = 1, *NR* = 0 OPTION).
*         ADDR   ABSOLUTE FWA TABLE TO VERIFY/UPDATE.
*         V      IF SET, CONTENTS OF SPECIFIED FIELD IN TABLE ENTRY
*                WILL BE VERIFIED WITH CONTENTS OF *VALUE* FIELD.
*                IF CLEAR, CONTENTS OF *VALUE* FIELD WILL BE STORED
*                INTO SPECIFIED FIELD IN TABLE ENTRY.
*         WI     WORD INDEX INTO TABLE OF ENTRY TO BE
*                VERIFIED/UPDATED.
*         FS     SIZE OF FIELD TO BE VERIFIED/UPDATED
*                (1 TO 60D BITS).
*         BP     LOW ORDER BIT POSITION OF FIELD TO VERIFY/
*                UPDATE (0 TO 59D).
*         VALUE  CONTENTS USED TO VERIFY SPECIFIED FIELD IN TABLE
*                ENTRY (IF *V* SET) OR UPDATE SPECIFIED FIELD IN TABLE
*                ENTRY (IF *V* NOT SET).  RIGHTMOST *FS* NUMBER OF
*                BITS OF *VALUE* ARE USED IF *FS* .LE. 42, OTHERWISE
*                42 BIT CONTENT OF *VALUE* IS USED, RIGHT JUSTIFIED
*                WITH BINARY ZERO FILL.
*
*         EXIT
*T,OR     12/ 0,12/ STAT,36/
*
*T,MB     1/V,5/ WI,6/ FS,6/ BP,42/ OLD VALUE
*         .
*         .
*         .
*T,MB+NR-1 1/V,5/ WI,6/ FS,6/ BP,42/ OLD VALUE
*
*         STAT   0 =  OPERATION COMPLETE.
*                1 =  INTERLOCK ALREADY SET (FOR *I* = 0, *NR* = 0
*                     OR *I* = 1, *NR* .NE. 0 PROCESSING).
*                2 =  VERIFICATION FAILED (FOR *NR* .NE. 0
*                     PROCESSING OF REQUEST WITH *V* SET).
*                     NO FURTHER REQUESTS WERE PROCESSED (TO PREVENT
*                     UPDATE AFTER VERIFY REQUEST THAT FAILED).
*                3 =  ENTRY TO INTERLOCK IS NOT IN USE (TOP 48 BITS OF
*                     *ADDR* = 0 FOR *I* = 0, *NR* = 0 OR *I* = 1,
*                     *NR* .NE. 0 PROCESSING).
*
*         V,WI,FS,BP  SAME AS ON ENTRY.
*         OLD VALUE   CONTENTS OF SPECIFIED FIELD IN TABLE ENTRY
*                     BEFORE UPDATE/VERIFY, RIGHT JUSTIFIED WITH
*                     BINARY ZERO FILL (RIGHTMOST 42 BITS OF FIELD
*                     IF *FS* .GT. 42).
*
*         *PP HUNG* WILL OCCUR FOR THE FOLLOWING CONDITIONS.
*         1.  *NR* .GT. 6.
*         2.  *FS* = 0.
*         3.  *BP* + *FS* .GT. 60D.
*         4.  *ADDR* INTERLOCK WAS NOT PREVIOUSLY SET FOR CLEAR
*             INTERLOCK REQUEST (*I* = 1, *NR* = 0 PROCESSING).
*         5.  *ADDR* ENTRY NOT IN USE (BYTE 0 = 0) FOR CLEAR INTERLOCK
*             REQUEST (*I* = 1, *NR* = 0 PROCESSING).
*         6.  JOB ADVANCE REQUESTED ON ILLEGAL ENTRY.
 
 
          PPR    UTEM,,,FEX
 
          AX1    36
          SX7    B1
          ZR     X1,UTE3     IF SET *ADDR* INTERLOCK OPTION
          MX2    -3
          BX3    -X2*X1      NUMBER OF REQUESTS IN MESSAGE BUFFER
          AX1    5
          MX0    -42
          BX1    -X1*X7
          BX7    X1+X3
          ZR     X7,UTE3     IF CLEAR *ADDR* INTERLOCK OPTION
          NZ     X1,UTE0.1   IF NOT AN INTERLOCK REQUEST
          SA4    X5          READ TABLE ENTRY
          MX6    12
          SX7    B1+         SET RETURN STATUS
          BX6    X6*X4
          LX4    59-0
          NZ     X6,UTE0     IF NOT AN EMPTY ENTRY
          SX7    3           SET REPLY
          EQ     UTE4        EXIT
 
 UTE0     NG     X4,UTE4     IF ENTRY ALREADY INTERLOCKED
 UTE0.1   SA4    A5+B1       GET MESSAGE BUFFER REQUEST
          SB4    X3
          SB3    6
          SB5    60
          GT     B4,B3,HNG   IF NUMBER OF REQUESTS .GT. 6
 UTE1     SB4    B4-B1       DECREMENT MESSAGE BUFFER REQUESTS
          BX2    -X0*X4      VALUE TO VERIFY/UPDATE FIELD WITH
          MX6    -6
          BX3    X0*X4
          AX4    42
          BX1    -X6*X4      LOW ORDER BIT POSITION OF FIELD
          AX4    6
          SB3    X1
          BX6    -X6*X4      FIELD SIZE IN BITS
          MX7    1
          SB6    X6
          SB7    B6-B1
          ZR     B6,HNG      IF FIELD SIZE = 0
          AX7    B7          BUILD FIELD MASK
          SB7    B3+B6
          GT     B7,B5,HNG   IF FIELD EXCEEDS WORD BOUNDARY
          AX4    6
          LX7    B6          RIGHT JUSTIFY MASK
          MX6    -5
          BX2    X7*X2       FIELD SIZE BITS OF VALUE
          BX4    -X6*X4      TABLE WORD INDEX
          IX4    X5+X4       TABLE ENTRY ABSOLUTE ADDRESS
          SA1    X4          GET TABLE ENTRY
          SB7    B5-B3
          LX1    B7          RIGHT JUSTIFY FIELD IN TABLE ENTRY
          BX6    X7*X1       CONTENTS OF FIELD IN TABLE ENTRY
          BX1    -X7*X1
          BX7    -X0*X6      RETURN OLD VALUE OF FIELD
          BX1    X1+X2       REPLACE FIELD WITH NEW VALUE
          BX7    X3+X7
          SA7    A4
          SX7    B1+B1       RETURN STATUS = 2 IF VERIFY REJECT
          PL     X3,UTE5     IF FIELD TO BE UPDATED
          BX6    X6-X2
          NZ     X6,UTE4     IF FIELD DOES NOT VERIFY
 UTE2     SA4    A4+B1       GET NEXT REQUEST
          NZ     B4,UTE1     IF MORE REQUESTS
          LX7    41-1
          BX7    X7*X5
          ZR     X7,PPR1     IF NO *ADDR* INTERLOCK OPTION
          SX7    B1          SET *ADDR* INTERLOCK
 UTE3     SA1    X5          GET TABLE ENTRY INTERLOCK
          MX0    48
          BX0    X0*X1
          BX4    X0+X7
          ZR     X4,HNG      IF CLEARING INTERLOCK ON UNUSED ENTRY
          MX3    -1
          BX4    -X3*X1      PREVIOUS INTERLOCK VALUE
          BX2    X4+X7
          ZR     X2,HNG      IF CLEARING ALREADY CLEAR INTERLOCK
          BX1    X3*X1
          BX6    X1+X7
          LX2    X7,B1
          BX3    -X3-X7
          BX7    X7+X2       RETURN STATUS = 3 IF ENTRY NOT IN USE
          ZR     X0,UTE4     IF *ADDR* ENTRY NOT IN USE
          BX7    X4*X7       RETURN STATUS = 1 IF SET INTERLOCK REJECT
          BX4    X4*X7       INTERLOCK STATUS .AND. REQUEST BIT
          LX4    59
          NG     X4,UTE3.1   IF WORD ALREADY INTERLOCKED
          SA6    X5
 UTE3.1   LX3    40-0        CHECK JOB ADVANCE OPTION
          BX3    X3*X5
          NZ     X3,UTE6     IF EJT ENTRY JOB ADVANCE NEEDED
 UTE4     LX7    36          SAVE RETURN STATUS
          SA7    A5
          EQ     PPRX        EXIT
 
 UTE5     LX6    X1,B3       REPOSITION TABLE ENTRY
          SA6    X4          STORE UPDATED TABLE ENTRY
          EQ     UTE2        PROCESS NEXT REQUEST
 
 UTE6     MX3    -6
          BX1    -X3*X6
          SB3    PPRX        SET EXIT ADDRESS FOR *JAV*
          SX1    X1-EXJS*2
          NZ     X1,UTE4     IF JOB NOT AT CONTROL POINT
          SA1    X5+B1       GET CONTROL POINT NUMBER
          ERRNZ  SCHE-JSNE-1 CODE DEPENDS ON VALUE
          AX1    12
          BX1    -X3*X1
          LX1    7
          TX2    X1,-SCA
          PL     X2,HNG      IF ILLEGAL CONTROL POINT
          SA7    A5          INDICATE OPERATION COMPLETE
          SB7    X1
          EQ     JAV         CHECK FOR JOB ADVANCE
 VFLM     SPACE  4,15
***       VFLM - VERIFY FIELD LENGTH.
*
*         ENTRY
*T, OR    12/  VFLM, 12/  CP, 36/
*         CP     CONTROL POINT.
*                0 = USE THE CONTROL POINT TO WHICH THE PP IS ASSIGNED.
*
*         EXIT
*T, OR    12/0, 12/  ST, 36/
*         ST     STATUS
*                0 = NO DOUBLE-BIT ERRORS ENCOUNTERED.
*                1 = JOB TO VERIFY FL FAILED.
*                2 = FIELD LENGTH VERIFICATION ALREADY IN PROGRESS.
 
 
          PPR    VFLM
 
          SX7    B1          PRESET RESPONSE
          LX7    36
          TEQ    (/CME/VLM,CME,/MONITOR/PPR1)
 VFPM     SPACE  4,30
***       VFPM - VERIFY FET PARAMETERS.
*
*         ENTRY
*T, OR    12/  VFPM,12/  VO,18/  ,18/  FA
*         VO     FET PARAMETER VALIDATION OPTION.
*                0 = NO FET PARAMETER VALIDATION.
*                1 = VALIDATE FIRST AND LIMIT ONLY.
*                2 OR 3 = VALIDATE FIRST, IN, OUT, AND LIMIT.
*
*         EXIT
*T, OR    12/  0,12/  ST,36/
*         ST     STATUS
*                0 = NO ERROR.
*                1 = ILLEGAL FET ADDRESS.
*                2 = BUFFER ARGUMENT ERROR.
*T, MB+2  12/ 0, 24/ IN, 24/ OUT
*T, MB+3  1/R, 5/0, 6/ FETL, 24/ FIRST, 24/ LIMIT
*         R      SET IF RANDOM FILE.
*         FETL   FET LENGTH - 5.
*
*         FIRST, IN, OUT, LIMIT ARE RETURNED ONLY IF FET PARAMETER
*         VALIDATION IS REQUESTED.  ZERO VALUE IS RETURNED FOR THOSE
*         PARAMETERS NOT VALIDATED (FOR OPTION 1, IN=OUT=0 IS RETURNED,
*         FOR OPTION 2/3, FIRST=IN=OUT=LIMIT=0 IS RETURNED).
*         MB+2 AND MB+3 ARE NOT RETURNED IF ERROR IS DETECTED.
 
 
          PPR    VFPM
 
          SX7    B1          RETURN STATUS = ILLEGAL FET ADDRESS
          AX2    24
          SB3    PPR1        SET ERROR EXIT ADDRESS FOR *VFA*/*VFP*
          SB7    X2          SET CP/PCP ADDRESS
          LX7    36
          SB6    VFM1        SET RETURN ADDRESS FOR *VFA*
          EQ     VFA         VERIFY FET ADDRESS
 
 VFM1     BX0    X6          SAVE FET LENGTH - 5 AND RANDOM FLAG
          SX7    B1+B1       RETURN STATUS = BUFFER ARGUMENT ERROR
          SB6    VFM2        SET RETURN ADDRESS FOR *VFP*
          SA2    A5          GET FET PARAMETER VALIDATION OPTION
          MX6    -6
          SX1    B0
          LX2    -36
          BX6    -X6*X2
          LX7    36
          NZ     X6,VFP      IF FET PARAMETER VALIDATION NEEDED
 VFM2     BX7    X1+X0       SAVE FIRST AND LIMIT
          SA6    A5+3        SAVE IN AND OUT
          SA7    A6+B1
          BX7    X7-X7       RETURN STATUS = NO ERROR
          SA7    A5
          EQ     PPRX        EXIT
 VMSM     SPACE  4,25
***       VMSM - VALIDATE MASS STORAGE.
*         LEGAL ONLY WHEN MASS STORAGE VALIDATION IS SELECTED.
*
*         ENTRY
*T, OR    12/  VMSM,12/  EQ,12/  TK,12/  SF,12/
*         EQ     EST ORDINAL TO PROCESS.
*         TK     FIRST TRACK OF CHAIN FOR VTCS OPTION.
*         SF     SUBFUNCTION CODE AS DEFINED IN COMSCPS.
*
*         VEIS   VALIDATE EQUIPMENT WITH INTERLOCK.
*         VEQS   VALIDATE EQUIPMENT.
*         VTCS   VALIDATE TRACK CHAIN.
*
*         REPLY
*T, OR    12/,12/  RS,36/
*         RS     REPLY STATUS
*                BIT 0 SET = RESERVATION BIT COUNT ERROR.
*                BIT 1 SET = PRESERVED FILE COUNT ERROR.
*                BIT 2 SET = PERMIT CHAIN ERROR.
*                BIT 3 SET = CATALOG CHAIN ERROR.
*                BIT 4 SET = INDIRECT CHAIN ERROR.
*
*                BIT 0 SET = BAD TRACK CHAIN (VTCS ONLY).
*
*         *PP HUNG.* WILL OCCUR FOR AN ILLEGAL MASS STORAGE EQUIPMENT.
*
*         NOTE - IF THE REQUEST IS FOR AN INDEPENDENT SHARED DEVICE,
*         THE MST, TRT, AND DIT ARE READ FROM THE DEVICE TO CM BY *1RU*
*         BEFORE THE VMSM IS ISSUED TO CPUMTR.
*         IF THE *VEIS* SUBFUNCTION IS USED ON AN INDEPENDENT SHARED
*         DEVICE BECAUSE THE MST INTERLOCK WAS PREVIOUSLY LEFT SET,
*         THE *LPTU* FLAG MUST BE SET FIRST TO PREVENT *1RU* FROM
*         HANGING TRYING TO SET THE INTERLOCK.
 
 
          PPR    VMSM,(/ISD/VMS,ISD,/LSPMMF/CME0,LSPMMF,/MONITOR/PMR  ),
,(/VMS/VMS,VMS,/PROGRAM/HNG)
 VSAM     SPACE  4,30
***       VSAM - VALIDATE SECURITY ACCESS FUNCTIONS.
*
*         ENTRY
*T, OR    12/  VSAM, 12/  FN, 36/
*         FN = 0 (VJAS) - SET JOB ACCESS LEVEL.
*         FN = 1 (VSFS) - SET FILE ACCESS LEVEL.
*         FN = 2 (VAES) - VALIDATE ACCESS LEVEL FOR EQUIPMENT.
*         FN = 3 (VAJS) - VALIDATE ACCESS LEVEL/CATEGORIES FOR JOB.
*         FN = 4 (VJCS) - VALIDATE JOB CREATION PARAMETERS.
*         FN = 5 (VEDS) - VALIDATE EXPIRATION DATE.
*         FN = 6 (VJLS) - VALIDATE JOB ACCESS LEVEL LIMITS.
*
*
*      0  VJAS - SET JOB ACCESS LEVEL.
*
*         ENTRY
*T, OR    12/  VSAM, 12/  VJAS, 24/  , 12/  AL
*         AL     REQUESTED JOB ACCESS LEVEL.
*
*         EXIT
*T, OR    12/  0, 12/  ST, 36/
*         ST = 0 IF ACCESS LEVEL VALID (FUNCTION COMPLETE).
*
*         FUNCTION
*         DETERMINE IF THE SPECFIED ACCESS LEVEL IS VALID FOR THE
*         CALLING JOB.  IF VALID, SET THE NEW ACCESS LEVEL IN THE
*         CONTROL POINT AREA AND THE EJT ENTRY FOR THE JOB.
*
*         *PP HUNG.* WILL OCCUR IF AN INVALID ACCESS LEVEL IS
*         SPECIFIED.
*
*
*      1  VSFS - SET FILE ACCESS LEVEL.
*
*         ENTRY
*T, OR    12/  VSAM, 12/  VSFS, 12/  , 12/  FA, 12/  AL
*         FA     NFL ADDRESS FOR THE FNT ENTRY OF THE FILE.
*         AL     REQUESTED FILE ACCESS LEVEL.
*
*         EXIT
*T, OR    12/  0, 12/  ST, 36/
*         ST = 0 IF ACCESS LEVEL VALID (FUNCTION PERFORMED).
*
*         FUNCTION
*         DETERMINE IF THE SPECIFIED ACCESS LEVEL IS VALID FOR
*         THE CALLING JOB AND THE EQUIPMENT UPON WHICH THE
*         SPECIFIED JOB RESIDES.  IF VALID, SET THE NEW ACCESS
*         LEVEL IN THE FNT ENTRY FOR THE FILE.
*
*         *PP HUNG.* WILL OCCUR FOR ANY OF THE FOLLOWING CONDITIONS.
*         1)  THE FNT ENTRY FOR THE FILE IS NOT SET BUSY BEFORE
*             CALLING *VSAM*.
*         2)  AN INVALID ACCESS LEVEL IS SPECIFIED.
*
*
*      2  VAES - VALIDATE ACCESS LEVEL FOR EQUIPMENT.
*
*         ENTRY
*T, OR    12/  VSAM, 12/  VAES, 12/  EQ, 12/  , 12/  AL
*         EQ     EST ORDINAL FOR EQUIPMENT.
*         AL     REQUESTED ACCESS LEVEL.
*
*         EXIT
*T, OR    12/   0, 12/  ST, 36/
*         ST = 0 IF ACCESS LEVEL VALID.
*
*         FUNCTION
*         DETERMINE IF THE SPECIFIED ACCESS LEVEL IS WITHIN
*         THE EQUIPMENT LIMITS (OR, FOR A MASS STORAGE DEVICE,
*         WITHIN THE DEVICE LIMITS) FOR A SPECIFIED EQUIPMENT.
*
*         *PP HUNG.* WILL OCCUR FOR ANY OF THE FOLLOWING CONDITIONS.
*         1)  AN INVALID EST ORDINAL IS SPECIFIED.
*         2)  AN INVALID ACCESS LEVEL IS SPECIFIED.
*
*
*      3  VAJS - VALIDATE ACCESS LEVEL AND/OR CATEGORIES FOR JOB.
*
*         ENTRY
*T, OR    12/  VSAM, 12/  VAJS, 24/  , 12/  P
*T, MB    12/  , 12/  AL, 36/  AC
*         P      PROCESSING OPTIONS.
*                1 - ACCESS LEVEL ONLY.
*                2 - ACCESS CATEGORIES ONLY.
*                3 - BOTH ACCESS LEVEL AND ACCESS CATEGORIES.
*         AL     ACCESS LEVEL.
*         AC     ACCESS CATEGORIES.
*
*         EXIT
*T, OR    12/  0, 12/  ST, 36/
*         ST = 0 IF SPECIFIED *AL* AND/OR *AC* WERE VALID.
*
*         FUNCTION
*         DETERMINE IF THE SPECIFIED ACCESS LEVEL AND/OR
*         ACCESS CATEGORY SET ARE CURRENTLY LEGAL FOR THE
*         CALLING JOB.
*
*         *PP HUNG.* WILL OCCUR IF AN INVALID ACCESS LEVEL IS
*         SPECIFIED.
*
*
*      4  VJCS - VALIDATE JOB CREATION PARAMETERS.
*
*         ENTRY
*T, OR    12/  VSAM, 12/  VJCS, 12/  OT, 12/  UAL, 12/  IJL
*T, MB    12/  , 12/  ALVAL, 36/  ACVAL
*         OT     ORIGIN TYPE FOR JOB.
*         UAL    UPPER LIMIT ON ACCESS LEVELS FOR JOB
*                (4000B IF DEFAULT IS TO BE USED).
*         IJL    INITIAL JOB ACCESS LEVEL.
*         ALVAL  ACCESS LEVEL VALIDATION BITS (FROM VALIDUS).
*         ACVAL  ACCESS CATEGORY VALIDATION (FROM VALIDUS).
*
*         EXIT
*T, OR    12/  0, 12/  ST, 12/  AIJL, 12/  RUAL, 12/  RLAL
*T, MB    12/  , 12/  RALVAL, 36/  RACVAL
*         ST = 0 IF JOB MAY BE CREATED.
*         AIJL   ADJUSTED INITIAL JOB ACCESS LEVEL.
*         RUAL   RESTRICTED UPPER ACCESS LEVEL LIMIT.
*         RLAL   RESTRICTED LOWER ACCESS LEVEL LIMIT.
*         RALVAL RESTRICTED SET OF ACCESS LEVEL BITS.
*         RACVAL RESTRICTED SET OF ACCESS CATEGORY BITS.ATION
*
*         FUNCTION
*         DETERMINE IF THE NEW JOB CAN BE CREATED WITH THE
*         SPECIFIED VALIDATIONS AND WITHIN THE SPECFIED LIMITS.
*         THE INITIAL JOB ACCESS LEVEL SPECIFIED BY THE CALLER IS
*         THE LOCAL FILE ACCESS LEVEL, IF THE JOB IS BEING CREATED
*         FROM A LOCAL FILE.  OTHERWISE, THIS VALUE IS ZERO.  THE
*         UPPER LIMIT SPECIFIED BY THE CALLER IS FROM THE JOB CARD
*         (LINE ACCESS LEVEL LIMIT FOR INTERACTIVE JOBS).  IF THE
*         DEFAULT IS TO BE USED, 4000B IS SPECIFIED.
*
*         IF THE JOB CAN BE CREATED, RESTRICT THE ACCESS LEVEL
*         LIMITS AND VALIDATION BITS, AND THE ACCESS CATEGORY
*         VALIDATION BITS, TO BE CONSISTENT AND TO BE WITHIN
*         THE LIMITS FOR THE SPECIFIED JOB ORIGIN TYPE.
*
*         THE SPECIFIED INITIAL ACCESS LEVEL WILL BE ADJUSTED UPWARDS
*         IF NECESSARY TO THE RESTRICTED LOWER ACCESS LEVEL LIMIT.  IF
*         IT IS ALREADY ABOVE THIS LEVEL, IT WILL BE SET TO THE NEXT
*         HIGHEST ACCESS LEVEL IN THE RESTRICTED SET OF ACCESS LEVEL
*         BITS.  IF THERE ARE NO VALID LEVELS AT OR ABOVE *IJL*, THE
*         JOB CANNOT BE CREATED.
*         IF THE VALUE 4000B IS SPECIFIED FOR *UAL*, THE RESTRICTED
*         UPPER ACCESS LEVEL LIMIT WILL BE SET TO THE ADJUSTED INITIAL
*         ACCESS LEVEL, CALCULATED AS DESCRIBED ABOVE.
*
*         *PP HUNG.* WILL OCCUR FOR ANY OF THE FOLLOWING CONDITIONS.
*         1)  AN INVALID ACCESS LEVEL IS SPECIFIED.
*         2)  AN INVALID ORIGIN TYPE IS SPECIFIED.
*
*
*      5  VEDS - VALIDATE EXPIRATION DATE.
*
*         ENTRY
*T, OR    12/ VSAM, 12/ VEDS, 18/ , 18/ EXP
*         EXP    EXPIRATION DATE
*
*         EXIT
*T, OR    12/  0, 12/  ST, 36/
*         ST = 0 IF EXPIRATION DATE NOT YET REACHED.
*
*         FUNCTION
*         DETERMINE IF THE SPECIFIED EXPIRATION DATE HAS BEEN
*         REACHED (IF EXPIRATION DATE .LE. TODAY-S DATE).
*
*
*      6  VJLS - VALIDATE JOB ACCESS LEVEL LIMITS.
*
*         ENTRY
*T, OR    12/ VSAM, 12/ VJLS, 12/ OT, 12/ UAL, 12/ LAL
*         OT  = ORIGIN TYPE OF JOB.
*         UAL = UPPER ACCESS LEVEL LIMIT FOR JOB.
*         LAL = LOWER ACCESS LEVEL LIMIT FOR JOB.
*
*         EXIT
*T, OR    12/ 0, 12/ ST, 36/
*         ST = 0 IF ACCESS LEVEL LIMITS VALID.
*
*         FUNCTION
*         DETERMINE IF THE SPECIFIED JOB ACCESS LEVEL LIMITS
*         LIE WITHIN THE RANGE OF VALID ACCESS LEVELS FOR
*         THE SPECIFIED ORIGIN TYPE.
*
*         *PP HUNG.* WILL OCCUR FOR ANY OF THE FOLLOWING CONDITIONS.
*         1)  AN INVALID ACCESS LEVEL IS SPECIFIED.
*         2)  AN INVALID ORIGIN TYPE IS SPECIFIED.
 
 
          PPR    VSAM
 
          LX1    -36         GET SUBFUNCTION NUMBER
          SB4    X1-TVSAL
          MX0    -12
          PL     B4,HNG      IF ILLEGAL FUNCTION
          SA3    B7+JCIW     CHECK SUBSYSTEM ID
          BX1    -X0*X5      GET SPECIFIED ACCESS LEVEL
          SA2    A5+B1       GET (MB)
          TB5    OSSM        GET OPERATING SYSTEM SECURITY MODE
          LX3    -24
          BX3    -X0*X3
          SX7    X3-LSSI-1
          SB4    B4+TVSAL
          JP     TVSA+B4     PROCESS FUNCTION
 
*         EXIT TO SUBFUNCTIONS WITH -
*                (X0) = 48-BIT MASK.
*                (X1) = SPECIFIED ACCESS LEVEL (BYTE 4 OF (OR)).
*                (X2) = FIRST WORD OF MESSAGE BUFFER.
*                (X5) = OUTPUT REGISTER.
*                (X7) .GE. 0 IF THE JOB IS A SUBSYSTEM.
*                (B5) = OPERATING SYSTEM SECURITY MODE.
 
*         OPTION TABLE.
 
 TVSA     BSS    0
          LOC    0
 
+         EQ     VS01        (VJAS) - SET JOB ACCESS LEVEL
 
+         EQ     VS11        (VSFS) - SET FILE ACCESS LEVEL
 
+         EQ     VS21        (VAES) - VALIDATE *AL* FOR EQUIPMENT
 
+         EQ     VS31        (VAJS) - VALIDATE *AL*/*AC* FOR JOB
 
+         EQ     VS42        (VJCS) - VALIDATE JOB CREATION PARAMETERS
 
+         EQ     VS51        (VEDS) - VALIDATE EXPIRATION DATE
 
+         EQ     VS61        (VJLS) - VALIDATE JOB LIMITS
 
 TVSAL    BSS    0
          LOC    *O
 
*         *VJAS* (0) - SET JOB ACCESS LEVEL.
 
 VS01     ZR     B5,VSX1     IF SYSTEM IN UNSECURED MODE
          SB6    VS02        SET RETURN ADDRESS
          EQ     VAJ         VALIDATE ACCESS LEVEL FOR JOB
 
 VS02     ZR     X6,VSX3     IF ACCESS LEVEL NOT VALID
          SA2    B7+JSCW     GET CURRENT ACCESS LEVEL
          LX2    -45
          MX0    -3
          BX3    -X0*X2
          IX6    X1-X3       CHECK IF NEW *AL* LESS THAN OLD
          BX3    X2          CHECK IF VALIDATED FOR DOWNGRADE
          LX3    59-55+45
          BX6    -X3*X6
          BX6    X7*X6       CHECK IF THE JOB IS A SUBSYSTEM
          NG     X6,VSX3     IF INVALID ACCESS
          BX2    X0*X2       SET NEW ACCESS LEVEL IN *JSCW*
          BX6    X2+X1
          LX6    45
          SA6    A2
          EQ     VSX1        RETURN (NORMAL STATUS)
 
*         *VSFS* (1) - SET ACCESS LEVEL FOR FILE.
 
 VS11     SB6    VS12        SET RETURN ADDRESS
          EQ     VAJ         VALIDATE ACCESS LEVEL FOR JOB
 
 VS12     ZR     B5,VS13     IF SYSTEM IN UNSECURED MODE
          ZR     X6,VSX3     IF ACCESS LEVEL NOT VALID
 VS13     LX0    12          GET FNT ADDRESS
          BX2    -X0*X5
          SA3    B7+FLSW     GET RA
          LX2    -12
          MX0    -24
          LX3    -12
          BX3    -X0*X3
          LX3    6
          IX2    X3-X2       CALCULATE FNT ADDRESS
          SX3    B1
          ERRNZ  FSTL-1      CODE DEPENDS ON VALUE
          IX2    X2+X3       *FSTL* ADDRESS
          ERX3   X2          GET *FSTL*
          LX3    59-0
          NG     X3,HNG      IF FILE NOT SET BUSY
          LX3    12-59+0     GET EST ORDINAL
          MX0    -12
          SB6    VS14        SET RETURN ADDRESS
          BX3    -X0*X3
          EQ     VAE         VALIDATE ACCESS LEVEL FOR EQUIPMENT
 
 VS14     ZR     B5,VS15     IF SYSTEM IN UNSECURED MODE
          NG     X6,VSX3     IF ACCESS LEVEL NOT VALID
 VS15     SX3    B1+         GET CURRENT FILE ACCESS LEVEL
          ERRNZ  FUTL-FSTL-1 CODE DEPENDS ON VALUE
          IX2    X2+X3       *FUTL* ADDRESS
          ERX3   X2          GET *FUTL*
          LX3    -24
          MX0    -3
          ZR     B5,VS16     IF SYSTEM IN UNSECURED MODE
          BX6    -X0*X3
          IX6    X1-X6       CHECK IF NEW *AL* LESS THAN OLD
          SA4    B7+JSCW
          LX4    59-54       CHECK IF VALIDATED FOR DOWNGRADE
          BX6    -X4*X6
          BX6    X7*X6       CHECK IF THE JOB IS A SUBSYSTEM
          NG     X6,VSX3     IF INVALID ACCESS
 VS16     BX3    X0*X3       SET NEW ACCESS LEVEL IN *FUTL*
          BX7    X3+X1
          LX7    24
          EWX7   X2          REWRITE *FUTL*
          EQ     VSX1        EXIT (NORMAL STATUS)
 
*         *VAES* (2) - VALIDATE ACCESS LEVEL FOR EQUIPMENT.
 
 VS21     ZR     B5,VSX1     IF SYSTEM IN UNSECURED MODE
          LX5    -24         GET EST ORDINAL
          BX3    -X0*X5
          ZR     X3,HNG      IF INVALID EST ORDINAL
          TX4    X3,-ESTL
          PL     X4,HNG      IF INVALID EST ORDINAL
          LX5    24
          SB6    VS22        SET RETURN ADDRESS
          EQ     VAE         VALIDATE ACCESS LEVEL FOR EQUIPMENT
 
 VS22     NG     X6,VSX3     IF ACCESS LEVEL NOT VALID
          EQ     VSX1        EXIT (NORMAL STATUS)
 
*         *VAJS* (3) - VALIDATE ACCESS LEVEL / ACCESS CATEGORY SET.
 
 VS31     ZR     B5,VSX1     IF SYSTEM IN UNSECURED MODE
          BX4    X1          SAVE SELECTION PARAMETERS
          LX1    59-0
          PL     X1,VS33     IF ACCESS LEVEL NOT TO BE CHECKED
          LX0    36
          BX1    -X0*X2      GET SPECIFIED ACCESS LEVEL
          LX1    -36
          SB6    VS32        SET RETURN ADDRESS
          EQ     VAJ         VALIDATE ACCESS LEVEL FOR JOB
 
 VS32     ZR     X6,VSX3     IF ACCESS LEVEL NOT VALID
 VS33     LX4    59-1
          PL     X4,VSX1     IF ACCESS CATEGORY SET NOT TO BE CHECKED
          MX0    -32         GET SPECIFIED ACCESS CATEGORY SET
          BX2    -X0*X2
          SA3    B7+JSCW     GET VALID ACCESS CATEGORY SET FOR JOB
          BX3    -X0*X3
          BX6    -X3*X2
          NZ     X6,VSX3     IF NONVALID BITS SET IN REQUEST
          EQ     VSX1        EXIT (NORMAL STATUS)
 
*         *VJCS* (4) - VALIDATE JOB CREATION PARAMETERS.
 
 VS41     BX5    X5-X5       CLEAR OUTPUT REGISTER
          MX0    12          CLEAR ACCESS LEVELS AND CATEGORIES
          BX2    X0*X2
          EQ     VS411       EXIT
 
 VS42     ZR     B5,VS41     IF SYSTEM IN UNSECURED MODE
          SB4    X1-7
          GT     B4,B0,HNG   IF INVALID LOWER ACCESS LEVEL
          LX0    24          GET ORIGIN TYPE
          BX4    -X0*X5
          LX4    -24
          SB4    X4-IAOT
          GT     B4,B0,HNG   IF INVALID ORIGIN TYPE
          TA4    X4,JCB      GET ORIGIN TYPE VALIDATIONS FROM SCT
          LX4    -36
          MX0    -3
          BX3    -X0*X4      ORIGIN TYPE UPPER LIMIT
          LX4    -3
          BX4    -X0*X4      ORIGIN TYPE LOWER LIMIT
          SB4    X4          SET *LAL* TO ORIGIN TYPE LOWER LIMIT
          MX0    -12
          LX0    12
          BX1    -X0*X5
          LX1    -12
          SB3    X1+         SPECIFIED UPPER ACCESS LEVEL (*UAL*)
          BX6    X1          CHECK FOR *DEFAULT UAL* SPECIFICATION
          LX6    59-11
          NG     X6,VS44     IF DEFAULT TO BE USED FOR *UAL*
          SB5    X1-7
          GT     B5,B0,HNG   IF INVALID UPPER ACCESS LEVEL
          IX6    X1-X4
          NG     X6,VSX3     IF *UAL* .LT. ORIGIN TYPE LOWER LIMIT
          IX6    X3-X1
          PL     X6,VS45     IF *UAL* .LE. ORIGIN TYPE UPPER LIMIT
 VS44     SB3    X3+         SET *UAL* TO ORIGIN TYPE UPPER LIMIT
 
*         CONSTRUCT RESTRICTED SET OF ACCESS LEVEL VALIDATION BITS.
 
 VS45     SB5    B3-B4       CONSTRUCT MASK FOR VALID ACCESS LEVELS
          NG     B5,VSX3     IF *LAL* .GT. *UAL*
          MX3    1
          AX3    B5
          SB5    B3+36+1     ALIGN MASK
          LX3    B5
          BX6    X3*X2       CONSTRUCT SUBSET OF ACCESS LEVEL BITS
          ZR     X6,VSX3     IF NO VALID ACCESS LEVELS IN RANGE
          LX0    24
          BX2    X0*X2
          BX2    X2+X6       (X2) = UPDATED MESSAGE BUFFER WORD
 
*         CONSTRUCT RESTRICTED SET OF ACCESS CATEGORY VALIDATION BITS.
 
          SA3    SSML        GET SYSTEM ACCESS CATEGORY SET
          MX7    -32
          BX3    -X7*X3
          BX7    X7+X3       CONSTRUCT MASK
          BX2    X7*X2       (X2) = UPDATED MESSAGE BUFFER WORD
 
*         RESTRICT JOB ACCESS LEVEL LIMITS WITH RESTRICTED SET
*         OF ACCESS LEVEL VALIDATION BITS.
 
          MX0    -12
          BX4    -X0*X5      SAVE *IJL*
          BX7    X2
          SB6    B4-23       PUT *LAL* BIT IN BIT 59
          SX6    B4          GET LOWER ACCESS LEVEL LIMIT (*LAL*)
          AX7    B6          (CIRCULAR LEFT SHIFT)
          NG     X7,VS47     IF VALIDATION BIT SET FOR CURRENT *LAL*
 VS46     LX7    -1          INCREMENT *LAL*
          SX6    X6+B1
          PL     X7,VS46     IF VALIDATION BIT NOT SET FOR NEW *LAL*
 VS47     BX5    X0*X5       UPDATE *LAL* IN OUTPUT REGISTER
          BX5    X5+X6
          BX3    X6          SAVE *RLAL*
 VS48     BX7    X2          CHECK UPPER ACCESS LEVEL LIMIT (*UAL*)
          SB4    B3-23       PUT *UAL* BIT IN BIT 59
          AX7    B4          (CIRCULAR LEFT SHIFT)
          NG     X7,VS410    IF VALIDATION BIT SET FOR CURRENT *UAL*
 VS49     LX7    1           DECREMENT *UAL*
          SB3    B3-B1
          PL     X7,VS49     IF VALIDATION BIT NOT SET FOR NEW *UAL*
 VS410    SX6    B3+         UPDATE *UAL* IN OUTPUT REGISTER
          MX0    -12
          LX0    12
          LX6    12
          BX5    X0*X5
          BX5    X5+X6
          SX6    B3          GET *RUAL*
          SB4    X3          SAVE *RLAL*
          IX0    X3-X4
          PL     X0,VS410.2  IF *IJL* .LE. *RLAL*
          BX7    X2
          SB6    X4-23       PUT *IJL* BIT IN BIT 59
          AX7    B6          (CIRCULAR LEFT SHIFT)
          BX3    X4
          NG     X7,VS410.2  IF VALIDATION BIT SET FOR CURRENT *IJL*
 VS410.1  LX7    -1          INCREMENT *IJL*
          SX4    X4+B1
          IX0    X6-X4
          BX3    X4
          NG     X0,VSX3     IF *AIJL* ABOVE *RUAL*
          PL     X7,VS410.1  IF VALIDATION BIT NOT SET FOR *AIJL*
 VS410.2  MX0    -12         SET *AIJL* IN OUTPUT REGISTER
          LX0    24
          LX3    24
          BX5    X0*X5
          BX5    X5+X3
          LX1    59-11
          PL     X1,VS411    IF DEFAULT NOT TO BE USED FOR *UAL*
          LX3    -24
          SB3    X3+
          IX1    X6-X3
          ZR     X1,VS411    IF *AIJL* = *RUAL*
          LX3    12          RESET *RUAL* TO *AIJL* IN OR
          LX0    -12
          BX5    X0*X5
          BX5    X5+X3
          SB5    B3-B4       RECALCULATE MASK
          MX3    1
          AX3    B5
          SB5    B3+36+1
          LX3    B5
          BX6    X3*X2       RESET RESTRICTED SET OF ACCESS LEVELS
          LX0    24
          BX2    X0*X2
          BX2    X2+X6
 VS411    BX7    X2          UPDATE MESSAGE BUFFER
          SA7    A2
          EQ     VSX1        EXIT (NORMAL STATUS)
 
*         *VEDS* (5) - VALIDATE EXPIRATION DATE.
 
 VS51     MX0    -18
          SA2    PDTL
          BX1    -X0*X5      EXPIRATION DATE
          LX2    -18
          BX2    -X0*X2      TODAY-S DATE
          IX6    X2-X1
          PL     X6,VSX3     IF EXPIRATION DATE HAS BEEN REACHED
          EQ     VSX1        EXIT (NORMAL STATUS)
 
*         *VJLS* (6) - VALIDATE JOB ACCESS LEVEL LIMITS.
 
 VS61     ZR     B5,VSX1     IF SYSTEM IN UNSECURED MODE
          LX0    24          GET ORIGIN TYPE
          BX4    -X0*X5
          LX4    -24
          SB4    X4-IAOT
          GT     B4,B0,HNG   IF INVALID ORIGIN TYPE
          TA4    X4,JCB      GET LIMITS FOR ORIGIN TYPE FROM SCT
          LX4    -36
          MX0    -3
          BX3    -X0*X4      ORIGIN TYPE UPPER LIMIT
          LX4    -3
          SB4    X1-7
          GT     B4,B0,HNG   IF INVALID LOWER ACCESS LEVEL
          BX4    -X0*X4      ORIGIN TYPE LOWER LIMIT
          IX6    X3-X1
          NG     X6,VSX3     IF *LAL* .GT. ORIGIN TYPE UPPER LIMIT
          IX6    X1-X4
          MX0    -12
          NG     X6,VSX3     IF *LAL* .LT. ORIGIN TYPE LOWER LIMIT
          LX0    12          GET SPECIFIED *UAL*
          BX1    -X0*X5
          LX1    -12
          IX6    X3-X1
          SB4    X1-7
          GT     B4,B0,HNG   IF INVALID UPPER ACCESS LEVEL
          NG     X6,VSX3     IF *UAL* .GT. ORIGIN TYPE UPPER LIMIT
          IX6    X1-X4
          NG     X6,VSX3     IF *UAL* .LT. ORIGIN TYPE LOWER LIMIT
*         EQ     VSX1        EXIT (NORMAL STATUS)
 
*         *VSAM* EXIT PROCESSING.
 
 VSX1     SX6    B0+         RETURN NORMAL STATUS
 VSX2     MX0    -36         CLEAR BYTES 0 AND 1 OF OUTPUT REGISTER
          BX7    -X0*X5
          BX7    X7+X6       SET REPLY STATUS
          EQ     PPR1        EXIT
 
 VSX3     SX6    B1          RETURN REJECT STATUS
          LX6    36
          EQ     VSX2        SET OUTPUT REGISTER
          TITLE  PPU REQUEST PROCESSING SUBROUTINES.
 CCP      SPACE  4,20
**        CCP - CONVERT CPU SCHEDULING PARAMETERS.
*
*         ON CME MACHINES, CONVERT THE CPU SCHEDULING PARAMETERS IN
*         JCB WORD *CSJT* FROM MILLISECONDS TO *CSAW* UNITS (UNITS OF
*         64 MICROSECONDS) AND PLACE THE CONVERTED VALUES INTO JCB
*         WORDS *CSAT* AND *CSBT*.  ON NON-CME MACHINES, COPY THE
*         PARAMETERS WITHOUT CONVERSION FROM *CSJT* TO *CSAT*/*CSBT*.
*
*         ENTRY  (X4) = SERVICE CLASS.
*                (B3) = RETURN ADDRESS.
*
*         EXIT   PARAMETERS CONVERTED FOR SPECIFIED SERVICE CLASS.
*                (A1) = ADDRESS OF *JCB* *CSBT* WORD.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 6.
 
 
 CCP      BSS    0           ENTRY
          CX1    X4,JCB      CONVERT JCB ORDINAL TO OFFSET
          MX0    -12
          TA1    X1+CSJT,JCB GET UNCONVERTED PARAMETERS
          TNO    /CME/CCP,CME  CONVERT PARAMETERS FOR CME MACHINE
 
*         COPY PARAMETERS WITHOUT CONVERSION FOR NON-CME MACHINE.
 
          BX7    -X0*X1      UNEXTENDED CPU SLICE
          LX1    -12
          BX6    -X0*X1      RECALL CPU SLICE
          IX7    X7-X6       UNEXTENDED SLICE - RECALL SLICE
          LX1    -12
          BX2    -X0*X1      CPU SLICE EXTENSION
          IX7    X7+X2       UNEXTENDED SLICE + EXTENSION - RECALL SLICE
          LX6    -18
          BX6    X6+X2
          LX6    36
          BX6    X6+X7
          SA6    A1+B1
          ERRNZ  CSAT-CSJT-1 WORDS MUST BE CONTIGUOUS
          LX1    -12
          BX6    -X0*X1      SYSTEM I/O CPU THRESHOLD
          SA1    A6+B1
          ERRNZ  CSBT-CSAT-1 WORDS MUST BE CONTIGUOUS
          MX0    42
          BX1    X0*X1
          BX6    X1+X6
          SA6    A1
          JP     B3          RETURN
 HNG      SPACE  4,15
**        HNG - HANG PPU.
*
*         ALL REGISTERS ARE SAVED TO AID IN PROBLEM DIAGNOSIS.
*         LEAVE PPU OUTPUT REGISTER SET, SET PACKED TIME AND DATE IN
*         LAST WORD OF MESSAGE BUFFER, AND DISPLAY MESSAGE.
*         MAY BE CALLED FROM EITHER MONITOR OR PROGRAM MODE WHEN
*         ENTERED AT *HNG1*.
*
*
*         ENTRY  (A5) = PPU OUTPUT REGISTER ADDRESS.
*                (B5) = EXIT ADDRESS IF ENTERED AT *HNG1*.
*
*         USES   X - 1, 7.
*                B - 5.
*                A - 1, 7.
 
 
 HNG      RJ     SVR         SAVE REGISTERS
 HNG0     SA5    A5+         REREAD PP OUTPUT REGISTER
          SB5    HNGM        FLAG WE ARE HANGING PP TO *CHGM*
          EQ     .CHGM       ASSIGN *1MA* TO ISSUE DAYFILE MESSAGES
 
*         (B5) = EXIT ADDRESS.
 
 HNG1     RJ     SVR         SAVE REGISTERS
 HNG2     SA1    PDTL        SET PACKED TIME AND DATE
          SX7    4RHNG//32   ADD *HNG/* TO PACKED DATE/TIME
          PX7    X7
          LX7    5+36
          BX7    X7+X1
          SA1    A5          SET STORAGE MOVABLE FLAG
          SA7    A5+6
          MX7    1
          LX7    56-59
          BX7    X7+X1
          SA7    A5
          SA1    A5-B1       ADD PP NAME TO *PP HUNG* MESSAGE
          MX7    18
          BX7    X7*X1
          SX1    HNGA        SET *PP HUNG - XXX* MESSAGE
          SA7    X1+B1
*         EQ     MSC         SET MESSAGE IN SYSTEM CONTROL POINT
 MSC      SPACE  4
**        MSC - SET MESSAGE IN SYSTEM CONTROL POINT.
*
*         ENTRY  (X1) = MESSAGE ADDRESS.
*                (B5) = EXIT ADDRESS.
*
*         USES   X - 1, 7.
*                A - 1, 7.
 
 
 MSC      SA1    X1          READ FIRST WORD OF MESSAGE
          BX7    X1
          TA7    MS2W,SCA    SET MESSAGE IN SYSTEM CONTROL POINT
          SA1    A1+B1
          BX7    X1
          SA1    A1+B1
          SA7    A7+B1
          BX7    X1
          SA7    A7+B1
          JP     B5          EXIT
 
 
 HNGA     DATA   H*PP HUNG - *
          DATA   C*XXX*      NAME OF HUNG PP
 SABT     DATA   C* SYSTEM ABORT.*
 PMR      SPACE  4
**        PMR - ENTER PPU PROGRAM MODE REQUEST.
*
*         ENTRY  (X5) = OUTPUT REGISTER.
*
*         EXIT   TO *EPR*.
 
 
 PMR      TX3    A5-47*10B-1,-FP  SET PPU SHIFT COUNT
          BX7    X7-X7
          PX1    X7          DISABLE PPU REQUEST
          SX2    B1          SET REQUEST BIT
          AX3    3
          SB4    X3
          BX7    X1+X5
          AX0    X2,B4
          SA7    A5
          EQ     EPR         ENTER PROGRAM MODE REQUEST
 RZX      SPACE  4,10
**        RZX - RETURN ZERO OUTPUT REGISTER AND EXIT.
*
*         ENTRY  (A5) = OUTPUT REGISTER ADDRESS.
*
*         EXIT   TO *PPRX*.
*                (OR) = 0.
 
 
 RZX      BSS    0           ENTRY
          SX7    B0          CLEAR OUTPUT REGISTER
          SA7    A5
          EQ     PPRX        EXIT
 SPB      SPACE  4,15
**        SPB - SET PPU REQUEST BIT.
*
*         ENTRY  (X0) = 1 IF BIT TO BE SET.
*                (X0) = 0 IF BIT TO BE CLEARED.
*                (X1) = REQUEST WORD.
*                (B3) = EXIT ADDRESS.
*                (A1) = ADDRESS OF WORD.
*
*         EXIT   NONE.
*
*         USES   X - 0, 1, 2, 3, 6.
*                B - 4.
*                A - 6.
*
*         CALLS  NONE.
 
 
 SPB      BSS    0           ENTRY
          TX2    A5-47*10B-1,-FP  SET PPU SHIFT COUNT
          SX3    B1          SET MASK BIT
          AX2    3
          SB4    X2
          AX3    X3,B4       CLEAR PREVIOUS REQUEST
          BX1    -X3*X1
          AX0    X0,B4       SET REQUEST BIT
          BX6    X1+X0
          SA6    A1          STORE REQUEST WORD
          JP     B3          EXIT
 SVR      SPACE  4,10
**        SVR - SAVE REGISTERS.
*
*         EXIT   (BXP - BXP+7) = *A* AND *B* REGISTER VALUES.
*                (BXP+8 - BXP+15) = *X* REGISTER VALUES.
*
*         USES   X - 0, 6, 7.
*                A - 6, 7.
*                B - 1, 7.
 
 
 SVR      PS                 ENTRY/EXIT
          SB1    B7-B0       HOLD *B7*
          SB7    A7-B0       HOLD *A7*
          SA7    BXP+15      SAVE *X7*
          BX7    X0
          SA7    BXP+8       SAVE *X0*
          BX7    X6
          SA7    BXP+14      SAVE *X6*
          MX0    -18
          SX7    B7-B0       SET *A7*
          BX7    -X0*X7
          SX6    B1-B0       SET *B7*
          LX7    18
          BX6    -X0*X6
          SB1    1           RESET *B1*
          IX6    X7+X6
          SX7    A6-B0       SET *A6*
          SA6    BXP+7       SAVE *A7* AND *B7*
          BX7    -X0*X7
          SX6    B6-B0       SET *B6*
          LX7    18
          BX6    -X0*X6
          IX6    X7+X6
          SA6    A6-B1       SAVE *A6* AND *B6*
 
 .1       SET    5
          DUP    5
 RN       OCTMIC .1,1
          BX7    X"RN"
          SA7    A7-B1       SAVE *X"RN"*
 .1       SET    .1-1
          ENDD
 
 .1       SET    5
          DUP    5
 RN       OCTMIC .1,1
          SX6    A"RN"-B0    SET A"RN"
          BX6    -X0*X6
          SX7    B"RN"-B0    SET B"RN"
          LX6    18
          IFNE   .1,1,1
          BX7    -X0*X7
          IX6    X6+X7
          SA6    A6-B1       SAVE A"RN" AND B"RN"
 .1       SET    .1-1
          ENDD
 
          SX6    A0-B0       SET *A0*
          BX6    -X0*X6
          LX6    18
          SA6    A6-B1       SAVE *A0*
          EQ     SVR         RETURN
 VAE      SPACE  4,15
**        VAE - VALIDATE ACCESS LEVEL FOR EQUIPMENT.
*
*         ENTRY  (X1) = ACCESS LEVEL.
*                (X3) = EST ORDINAL OF EQUIPMENT.
*                (B6) = RETURN ADDRESS.
*                (X3) = EST WORD *EQDE* OF EQUIPMENT, IF ENTRY
*                       AT *VAE0*.
*                (X4) = OFFSET INTO EST FOR EQUIPMENT, IF ENTRY
*                       AT *VAE0*.
*
*         EXIT   (X6) .LT. 0, IF ACCESS LEVEL NOT VALID FOR EQUIPMENT.
*                TO *HNG*, IF ACCESS LEVEL SPECIFIED IS INVALID.
*
*         USES   X - 3, 4, 6.
*                A - 3, 4.
 
 
 VAE      BSS    0           ENTRY
          CX4    X3,EST      CONVERT EST ORDINAL TO OFFSET
          TA3    X4+EQDE,EST GET EST ENTRY
 VAE0     TA4    X4+EQAE,EST
          SX6    8
          LX4    -6          GET EQUIPMENT ACCESS LIMITS
          IX6    X1-X6
          PL     X6,HNG      IF INVALID ACCESS LEVEL
          PL     X3,VAE1     IF NOT MASS STORAGE EQUIPMENT
          MX6    -12
          BX3    -X6*X3      GET MST ADDRESS
          LX3    3
          SA4    X3+PFGL     GET DEVICE ACCESS LIMITS
 VAE1     LX4    -6
          MX6    -3
          BX3    -X6*X4      UPPER LIMIT
          LX4    -3
          BX4    -X6*X4      LOWER LIMIT
          IX6    X1-X4
          NG     X6,RB6      IF LESS THAN LOWER LIMIT
          IX6    X3-X1       CHECK FOR GREATER THAN UPPER LIMIT
          JP     B6          RETURN
 VAJ      SPACE  4,15
**        VAJ - VALIDATE ACCESS LEVEL FOR JOB.
*
*         ENTRY  (X1) = ACCESS LEVEL.
*                (B6) = RETURN ADDRESS.
*                (B7) = CONTROL POINT ADDRESS.
*
*         EXIT   (X6) = 0, IF ACCESS LEVEL NOT VALID FOR JOB.
*                TO *HNG*, IF ACCESS LEVEL SPECIFIED IS INVALID.
*
*         USES   X - 3, 6.
*                A - 3.
*                B - 3.
 
 
 VAJ      BSS    0           ENTRY
          SB3    X1-7
          GT     B3,B0,HNG   IF INVALID ACCESS LEVEL
          SA3    B7+JSCW     GET SET OF VALID AL-S FOR JOB
          SB3    X1+36+1
          MX6    1
          LX6    B3
          BX6    X6*X3       CHECK SPECIFIED *AL*
          JP     B6          RETURN
 VFA      SPACE  4,20
**        VFA - VERIFY FET ADDRESS.
*
*         ENTRY  (B3) = ERROR EXIT ADDRESS.
*                (B6) = RETURN ADDRESS.
*                (B7) = CPA.
*                (X1) = RELATIVE FET ADDRESS IN LOWER 18 BITS.
*                (X7) = ERROR STATUS.
*
*         EXIT   (B4) = FL.
*                (X0) = RA.
*                (X2) = (FLSW) LEFT SHIFTED BY -12.
*                (X5) = ABSOLUTE FET+1 ADDRESS.
*                (X6) = 12/ FET LENGTH - 5, 48/ 0.
*
*         USES   A - 2, 3, 7.
*                B - 4, 5.
*                X - ALL.
 
 
 VFA      SA2    B7+FLSW
          MX4    -12
          BX3    -X4*X2      FL/100B
          MX5    -18
          LX2    -12
          BX5    -X5*X1      RELATIVE FET ADDRESS
          LX3    6
          SX0    X2          RA/100B
          SB4    X3          FL
          SX3    X3-4
          LX0    6
          IX4    X5-X3
          PL     X4,RB3      IF FET ADDRESS .GE. FL - 4
          SB5    X5
          SX5    X5+B1
          LE     B5,B1,RB3   IF FET ADDRESS .LE. 1
          IX5    X0+X5       ABSOLUTE FET + 1 ADDRESS
          ERX3   X5          GET FET LENGTH
          MX6    -6
          LX3    -18
          BX6    -X6*X3
          MX1    1           GET RANDOM FILE FLAG
          LX3    18+12
          IX4    X4+X6
          PL     X4,RB3      IF LWA+1 FET .GT. FL
          AX7    X6,B1
          BX1    X1*X3
          LX6    48
          ZR     X1,RB6      IF NOT RANDOM FILE
          BX6    X6+X1       RETURN RANDOM FILE FLAG
          NZ     X7,RB6      IF FET LONG ENOUGH FOR RANDOM PROCESSING
          BX7    X3-X1       CLEAR RANDOM FLAG FROM FET
          LX7    -12
          BX6    X6-X1       REMOVE RANDOM FLAG FROM RESPONSE
          EWX7   X5
          JP     B6          RETURN
 VFP      SPACE  4,20
**        VFP - VERIFY FET PARAMETERS.
*
*         ENTRY  (B3) = ERROR EXIT ADDRESS.
*                (B4) = FL.
*                (B6) = RETURN ADDRESS.
*                (X5) = ABSOLUTE FET+1 ADDRESS.
*                (X6) = VALIDATION FLAGS (1 = VALIDATE FIRST/LIMIT,
*                       2 OR 3 = VALIDATE FIRST/IN/OUT/LIMIT).
*                (X7) = ERROR STATUS.
*
*         EXIT   (X1) = 12/ 0, 24/ FIRST, 24/ LIMIT.
*                (X6) = 12/ 0, 24/ IN, 24/ OUT.
*
*         USES   A - 1, 2, 3.
*                B - 4.
*                X - 1, 2, 3, 4, 6.
 
 
 VFP      MX3    -2
          IX3    X5-X3       FET+4
          ERX1   X5          GET FIRST
          ERX2   X3          GET LIMIT
          MX4    -18
          BX1    -X4*X1
          SX3    B4          FL
          BX4    -X4*X2
          IX3    X3-X4
          NG     X3,RB3      IF LIMIT .GT. FL OR LIMIT .LT. 0
          IX3    X1-X4
          PL     X3,RB3      IF FIRST .GE. LIMIT OR FIRST .LT. 0
          SB4    X1+
          AX6    1
          SX2    B1
          ZR     X6,VFP1     IF NO VALIDATION FOR IN AND OUT
          IX3    X5+X2       FET+2
          IX2    X3+X2       FET+3
          ERX3   X3          GET IN
          ERX2   X2          GET OUT
          SX3    X3
          SX2    X2
          IX6    X3-X1
          IX1    X2-X1
          BX1    X1+X6
          NG     X1,RB3      IF IN OR OUT .LT. FIRST
          IX6    X3-X4
          PL     X6,RB3      IF IN .GE. LIMIT
          IX1    X2-X4
          LX3    24
          PL     X1,RB3      IF OUT .GE. LIMIT
          BX6    X3+X2
          SX1    B4
 VFP1     LX1    24
          BX1    X1+X4
          JP     B6          RETURN
          TTL    CPUMTR/PROGRAM - PROGRAM MODE EXECUTION.
          TITLE  PRG - REQUEST TRANSLATION.
          QUAL   PROGRAM
 PRG      SPACE  4
**        PRG - PROCESS PROGRAM MODE REQUEST.
 
 
 PRG1     SA7    A5          STORE *OR* FOR PROGRAM MODE REQUEST
          EQ     PRG
 
 PRGX     SX6    1           SET REQUEST EXIT
          SA6    PX
 MJ1      XJ     *           EXIT
 
 PRG      SA1    PR          CHECK REQUEST WORD
 
*         ALL PENDING REQUESTS ARE PROCESSED BEFORE ANY ADDITIONAL
*         REQUESTS ARE PROCESSED.
 
          SA3    PRGA        CHECK PENDING REQUESTS
          BX7    X7-X7
          NZ     X3,PRG2     IF PENDING REQUESTS
          BX3    X1          SELECT FROM NEW REQUESTS
 PRG2     ZR     X3,PRGX     IF NO REQUESTS
          LX3    -11
          PX4    X7          SET BIT 58
          NX1,B4 X3          FIND REQUEST BIT
          AX2    X4,B4       POSITION BIT
          LX3    11
          SX4    B4
 
*         CLEAR REQUEST BIT.
 
 +        SA1    A1          **** PERFORM IN 1 WORD ****
          BX6    X1-X2       **** PERFORM IN 1 WORD ****
          SA6    A1          **** PERFORM IN 1 WORD ****
 
          BX6    X3-X2       CLEAR REQUEST
          AX2    48
          SA6    A3
          NZ     X2,MNR      IF MONITOR REQUEST
 
*         PROCESS PPU REQUEST.
 
          LX4    PPCES
          TA5    X4+1-11*PPCE,FP
          LX4    PPXES-PPCES
          TA2    X4+ACPP-11*PPXE,FPX
          UX1,B4 X5          UNPACK REQUEST
          SB7    X2          SET CP ADDRESS
          SA3    TPPR-CPUM+B4 SET PROCESSOR ADDRESS
          LX3    30
          SB6    X3
          TJP    (/PROBE/PRG,PROBE,B6)  PROCESS REQUEST
 
 PRGA     CON    0           PENDING REQUEST WORD
 
**        EXIT TO PROCESSOR WITH -
*         (X1) = BITS 0 - 47 OF OUTPUT REGISTER.
*         (X2) = *ACPP*.
*         (X3) = PROCESSOR CONTROL WORD SHIFTED 30 BITS.
*         (X7) = 0.
*         (A2) = *ACPP* ADDRESS.
*         (A5) = OUTPUT REGISTER ADDRESS.
*         (B4) = REQUEST NUMBER.
*         (B6) = PROCESSOR ADDRESS.
*         (B7) = CONTROL POINT ADDRESS.
          TITLE  PPU REQUEST PROCESSORS.
 CKS      SPACE  4
**        CKS - CHECKSUM SELECTED AREA.
*
*         ENTRY  (A5) = PPU OUTPUT REGISTER ADDRESS.
*                (X7) = 0.
 
 
 CKS      SA2    B7+1        GET RA
          MX6    -17
          AX5    24
          BX5    -X6*X5      LENGTH
          BX1    -X6*X1      FWA
          AX2    36          RA
          IX1    X2+X1       ABSOLUTE FWA
          SX0    B1
          IX5    X5-X0
          SX4    2
 CKS1     ERX2   X1
          LX7    1
          IX3    X1+X0
          IX6    X7+X2
          ERX3   X3
          LX6    1
          IX1    X1+X4
          SX5    X5-2        DECREMENT LENGTH
          IX7    X6+X3
          PL     X5,CKS1     IF CHECKSUM NOT COMPLETE
          LX5    -1
          SA3    A5+B1       COMPARE CHECKSUM
          PL     X5,CKS2     IF EVEN WORD COUNT
          BX7    X6
 CKS2     BX6    X7-X3
          ZR     X6,CKS3     IF COMPARE SUCCESSFUL
          SX6    B1          RETURN RESPONSE
 CKS3     SA7    A3          STORE NEW CHECKSUM
          SA6    A5          STORE OUTPUT REGISTER
          JP     PRG
 CST      SPACE  4,10
**        CST - CLEAR STORAGE.
*
*         ENTRY  (A5) = OUTPUT REGISTER ADDRESS.
*                (X2) = *ACPP*.
*
*         EXIT   TO CLEAR STORAGE PROCESSOR.
*
*         USES   X - 2.
*                A - 2, 5.
 
 
 CST      BSS    0           ENTRY
          AX2    24          SET CP/PCP ADDRESS
          SB7    X2
          TJP    (/PROGRAM/CSE1,CME,/PROGRAM/CSE,MECS,/PROGRAM/CSC,CMU,/
,PROGRAM/CSP)
 DLKM     SPACE  4,18
**        DLK - DELINK TRACK CHAIN.
*
*         ENTRY  (A5) = OUTPUT REGISTER ADDRESS.
*
*         EXIT   (X1) = FIRST TRACK OF CHAIN TO DROP.
*                (X2) = TRACK WHICH FIRST TRACK IS TO BE LINKED TO.
*                (X3) = TDGL WORD OF MST.
*                (X5) = -7777B.
*                (B3) .LT. 4  FLAG TO DROP TRACKS PROCESSOR.
*                (B6) = FIRST WORD ADDRESS OF TRT.
*                (A3) = ADDRESS OF TDGL WORD IN MST.
*
*         USES   A - 1, 4, 6, 7.
*                B - 3.
*                A - 4, 7.
*
*         CALLS  CTR, DTC.
 
 
 DLK      SB3    DLK1        SET *CTR* RETURN
          EQ     CTR         CHECK TRACK REQUEST
 
 DLK1     AX4    X5,B1       TRACK MASK = -3777B
          MX6    -2
          BX7    -X4*X7      LAST TRACK TO DROP
          BX6    -X6*X7      BYTE NUMBER
          SA4    TMSK+X6     READ TRACK CLEARING MASK
          SB3    X6          RESERVATION BIT SHIFT COUNT
          AX7    2           TRT WORD NUMBER
          BX6    -X5+X4      DISABLE CLEARING RESERVATION AND INTERLOCK
          SA4    B6+X7       READ TRT WORD
          LX7    X4,B3       CHECK LAST TRACK RESERVED
          LX7    56
          PL     X7,HNG      IF TRACK NOT RESERVED
          BX7    X6*X4       CLEAR LINK IN LAST TRACK
          SA7    A4
          SB3    B0          INDICATE CALLED FROM *DLK*
          EQ     DTC1        EXIT TO DROP TRACKS PROCESSOR
 DTC      SPACE  4
**        DTC - DROP TRACK CHAIN.
*
*         ENTRY  (A5) = PPU OUTPUT REQISTER ADDRESS.
*
*         EXIT   (OR) = NUMBER OF SECTORS RETURNED TO SYSTEM.
*
*         USES   X - ALL.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 6, 7.
*
*         CALLS  CCP, CTR.
 
 
 DTC      SB3    DTC1        SET *CTR* RETURN
          EQ     CTR         CHECK TRACK REQUEST
 
 
*         ENTERED HERE FROM *DLKM* PROCESSOR.
 
 DTC1     LX3    12          POSITION TRACK COUNT
          AX4    X5,B1       (X4) = TRACK MASK = -3777B
          SA5    A5
          BX7    -X4*X3
          LX5    59-58
          LX3    -24
          PL     X5,DTC1.1   IF NOT PROGRAM MODE
          SA7    DTCB
 DTC1.1   MX5    -12
          BX7    -X4*X1
          BX6    X4*X1       DROPPING ALL TRACKS FLAG
          BX3    -X4*X3
          SA1    A3+DILL-TDGL  GET 819 DEVICE FLAG
          SB5    X3+B6       FIRST FREE TRACK POINTER
          LX1    0-22
          SX3    B1
          BX1    X3*X1       819 DEVICE FLAG
          LX7    -2
          SB7    X1
          SA1    A3+MDGL-TDGL  READ SECTOR LIMITS
          BX1    -X4*X1      SECTOR LIMIT
          LX1    24
          BX3    X3+X1
          NZ     X6,DTC3     IF DROPPING ALL TRACKS
 
*         ENTER SECTOR NUMBER/LINK BYTE IN LAST TRACK.
 
          BX0    X4*X7       BYTE NUMBER
          LX0    2
          SB2    X0+56       RESERVATION BIT SHIFT COUNT
          LX1    -24
          LX0    2
          IX1    X2-X1       CHECK EOI SECTOR NUMBER
          SB4    X0
          ZR     B3,DTC2     IF ENTERED FROM *DLK*
          PL     X1,HNG      IF ILLEGAL LAST SECTOR WRITTEN
 DTC2     LX0    1
          SB3    B4+X0       LINK BYTE SHIFT COUNT
          SB4    B3-48
          SA1    B6+X7       READ TRT WORD
          AX7    X5,B4       POSITION BYTE CLEARING MASK
          AX2    X2,B4       POSITION SECTOR NUMBER/LINK
          BX7    X7*X1       CLEAR OLD LINK
          SB4    A1          SET LINK ADDRESS
          BX7    X7+X2       MERGE SECTOR LIMIT/LINK
          EQ     DTC6        DROP REST OF CHAIN
 
*         DECREMENT PRESERVED FILE COUNT AND CHECK MRT PROCESSING.
 
 DTC3     BX2    X4*X7       BYTE NUMBER
          LX2    2
          SA1    X7+B6       READ TRT WORD
          SB2    X2
          LX1    X1,B2       POSITION PRESERVED FILE BIT
          LX1    59-11
          NG     X1,DTC9     IF PRESERVED FILE
          ZR     X6,DTC5     IF NOT DROPPING ALL TRACKS
          MX1    1           FORCE *MRT* UPDATE
          BX6    X6-X6
 DTC4     PL     X1,DTC5     IF NOT TO CLEAR *MRT* BIT
          TPL    X0,(/ISDMMF/CMB,ISDMMF,/PROGRAM/HNG)  IF SHARED DEVICE
 
*         DROP TRACK CHAIN.
*         REENTRY HERE FROM */PROGRAM/CMB*.
 
 DTC5     IX6    X6+X3       INCREMENT TRACKS/PRU-S DROPPED
          TNZ    B7,(/BUFIO/DIB,BUFIO,/PROGRAM/HNG)  IF BUFFERED DEVICE
 
*         REENTRY HERE FROM */IO819/DLB*.
 
 DTC5.1   SA1    DTCB        FETCH TRACK LIMIT
          BX2    X7
          BX0    X4*X7       BYTE NUMBER
          LX2    2           TRACK NUMBER
          LX0    2
          IX1    X1-X2
          SA2    TMSK+X0     READ TRACK CLEARING MASK
          SB2    X0+56       RESERVATION BIT SHIFT COUNT
          NG     X1,HNG      IF TRACK BEYOND DEVICE LIMIT
          LX0    2
          SA1    B6+X7       READ TRT WORD
          SB3    X0
          LX0    1
          SB3    B3+X0       BYTE NUMBER * 12 + 12
          SX0    A1-B5
          BX7    X2*X1       CLEAR TRACK
          PL     X0,DTC6     IF NOT FIRST FREE TRACK
          SB5    A1          UPDATE FIRST FREE TRACK POINTER
 DTC6     SA7    A1          STORE TRT WORD
          LX2    X1,B3       POSITION LINK BIT
          LX1    X1,B2       POSITION RESERVATION BIT
          AX2    48
          PL     X1,HNG      IF NOT RESERVED
          BX7    -X4*X2
          LX7    -2
          NG     X2,DTC5     IF NOT END OF CHAIN
 
*         UPDATE REMAINING TRACK COUNT.
*         UPDATE FIRST FREE TRACK POINTER.
 
          SA3    A5          LOCATE DEVICE MST
          MX0    -9
          AX3    36
          BX0    -X0*X3      EXTRACT EST ORDINAL
          CX3    X0,EST      CONVERT EST ORDINAL TO OFFSET
          MX0    -12
          TA3    X3+EQDE,EST READ EST ENTRY
          BX7    -X0*X3
          LX7    3
          SA3    X7+TDGL     READ *TDGL* WORD OF MST
          MX0    -24
          BX7    -X0*X6      NUMBER OF TRACKS DROPPED
          SX1    B5-B6       FIRST FREE TRACK
          IX7    X3+X7       ADD TRACKS TO *TDGL*
          AX6    24          NUMBER OF SECTORS DROPPED
          LX7    -12
          SB5    PRG
          BX7    X4*X7       CLEAR FIRST FREE TRACK POINTER
          AX3    24
          BX7    X7+X1       UPDATE FIRST FREE TRACK
          LX7    12
          BX5    -X4*X3      LENGTH OF TRT
          SA7    A3
          SA2    A3+NVGL-TDGL
          SX3    B1+
          PL     X2,DTC8     IF NO FLAW REQUEST
          LX2    12
          BX2    -X4*X2
          LX2    -2
          BX0    -X0+X2
          SA2    B6+X2       READ TRT WORD FOR TRACK
          LX0    2
          SB3    X0
          IX7    X7-X3
          AX3    B3
          BX2    X3-X2
          BX3    X3*X2
          ZR     X3,DTC8     IF TRACK RESERVED
          SB3    B3+X0
          SB3    B3+X0
          SB3    B3+B3
          SA7    A3          STORE UPDATED *TDGL*
          LX4    12
          SB3    B3+B3
          AX4    B3
          BX7    -X4+X2
          SA7    A2
 DTC8     SA2    A5+
          BX7    X6          SET REPLY
          LX2    59-58
          NG     X2,CCP1     IF PROGRAM MODE
          SA2    /MONITOR/T1 RESTORE (B2)
          SB5    /MONITOR/PPRX  SET MONITOR MODE EXIT
          SB2    X2+
          EQ     CCP1        CHECK FOR CHECKPOINT REQUEST
 
*         PROCESS PRESERVED FILE.
 
 DTC9     LX1    4           POSITION TRACK INTERLOCK
          ZR     X6,DTC4     IF NOT DROPPING ALL TRACKS
          SA2    A3+B1       READ MST
          ERRNZ  ACGL-1      INDEX MUST BE ONE
          LX5    24
          BX6    -X5*X2      PRESERVED FILE COUNT
          ZR     X6,DTC4     IF FILE COUNT IS ZERO
          SX5    B1
          LX5    24
          IX6    X2-X5       DECREMENT PRESERVED FILE COUNT
          SA6    A2
          BX6    X6-X6
          EQ     DTC4        RE-ENTER PROCESSING
 
 DTCA     BSS    0           SCRATCH WORD
          CON    0           MUST BE THE WORD BEFORE TMSK
 
 TMSK     BSS    0           TRACK CLEARING MASKS
          VFD    12/0,12/-0,12/-0,12/-0,12/3567B  BYTE 0
          VFD    12/-0,12/0,12/-0,12/-0,12/5673B  BYTE 1
          VFD    12/-0,12/-0,12/0,12/-0,12/6735B  BYTE 2
          VFD    12/-0,12/-0,12/-0,12/0,12/7356B  BYTE 3
 DTCB     CON    0           DEVICE TRACK LIMIT
 LCC      SPACE  4
**        LCC - *PIOM* LOAD CENTRAL PROGRAM (SF = 6).  PROGRAM MODE.
*
*         ENTRY  (A5) = PP OUTPUT REGISTER.
*                (X5) = *PIOM* REQUEST.
*                (B7) = CP ADDRESS.
*
*         USES   X - ALL.
*                B - 3, 4, 5, 6.
*                A - 1, 2, 4.
*
*         CALLS  CMP, MSR.
 
 
 LCC      SA2    B7+FLSW     GET RA AND FL
          MX6    -12
          SB5    X5          GET RELATIVE CM ADDRESS OF LOAD
          BX4    -X6*X2      FL/100B
          LX2    -12
          MX6    -RMSK
          BX2    -X6*X2      RA/100B
          LX5    -18
          SA1    A5+B1       GET PARAMETERS FROM MESSAGE BUFFER
          LX4    6
          LX2    6
          SX3    X5          GET LWA+1 OF LOAD
          LX1    -12
          LX5    18
          ZR     X3,LCC1     IF NO LWA SPECIFIED FOR LOAD
          IX0    X4-X3
          BX4    X3
          NG     X0,HNG      IF LWA+1 .GT. FL
 LCC1     BX1    -X6*X1      ABSOLUTE CM ADDRESS
          ERX3   X1
          SB6    X4          FL OR RELATIVE LWA+1 LOAD
          SB4    X3-1        GET PROGRAM LENGTH
          MX6    -36
          SB3    B4+B5       RELATIVE LOAD ADDRESS + LENGTH
          SX3    IFLS        RETURN STATUS = INSUFFICIENT FL
          BX5    -X6*X5
          GT     B3,B6,LCC2  IF INSUFFICIENT FIELD LENGTH FOR LOAD
          SX0    B1
          IX0    X1+X0       FWA PROGRAM CODE
          SX3    B5
          IX1    X2+X3       CM ADDRESS LOADING TO
          SX2    B4+
          BX3    X3-X3       RETURN STATUS = NO ERROR
          IX5    X5+X2       ADVANCE RELATIVE CM ADDRESS
          IX1    X0-X1
          SB6    LCC2        *CMP* *MSR* RETURN ADDRESS
          TJP    (/CME/MSR,CME,/PROGRAM/CMP,CMU,/MONITOR/MSR)
 
 LCC2     LX3    -24
          BX7    X5+X3
          EQ     PRG1        EXIT TO STORE OUTPUT REGISTER
 PIP      SPACE  4,15
**        PIP - *PIOM* PROGRAM MODE PROCESSOR.
*
*         ENTRY  (A5) = PP *OR* ADDRESS.
*                (X5) = (OR).
*                (B7) = CP ADDRESS.
*                SEE *PIOM* DOCUMENTATION FOR *OR* AND *MB*
*                   DESCRIPTION.
*                (MB+1) = 1/MODE,23/,18/PROC,18/SUBFUNCTION DATA.
*                   MODE = 1 (PROGRAM MODE).
*                   PROC = PROGRAM MODE *PIOM* RETURN ADDRESS.
*
*         EXIT   TO *PIOM* PROCESSOR RETURN ADDRESS.
*                (B5) = *PIOM* SUBFUNCTION - 1.
*                A5, B7, X5 SAME AS ON ENTRY.
 
 
 PIP      AX1    42          GET *PIOM* SUBFUNCTION CODE
          SB4    X1-LCRS
          ZR     B4,LCC      IF LOAD CM RESIDENT CODE SUBFUNCTION
          SA3    A5+2        GET PROGRAM MODE PROCESSOR ADDRESS
          SB5    X1-1        SUBFUNCTION - 1
          LX3    -18
          SB6    X3
          JP     B6          JUMP TO *PIOM* SUBFUNCTION PROCESSOR
 RDC      SPACE  4
**        RDC - REQUEST DATA CONVERSION.
*
*         ENTRY  (A5) = PPU OUTPUT REGISTER ADDRESS.
*         REFER TO *RDCM* DOCUMENTATION FOR MORE INFORMATION.
*
*         EXIT   TO *PRG*.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                B - 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 3, 4, 6, 7.
*
*         CALLS  DSB.
 
 
 RDC      SA1    A5          PRESET (A1)
          MX4    -6
          SB3    B1          SET WORD COUNT
          LX1    24
          SB6    RCDS        CHECK FOR *RCIS*/*RCDS* SUBFUNCTIONS
          ERRNZ  RCIS        CODE DEPENDS ON VALUE
          BX2    -X4*X1
          LX1    6
          SB5    6           SHIFT COUNT
          BX5    -X4*X1      MILLIUNITS CONVERSION
          LX1    6
          BX1    -X4*X1      VALIDATE WORD COUNT AND SRU POINTER
          MX4    -30         (X4) = DATA MASK
          ZR     X2,RDC4     IF 1 WORD TO CONVERT (0 IMPLIES 1)
          SB3    X2          SET SUBFUNCTION / WORD COUNT
          SB4    X1          SET SRU POINTER
          GT     B3,B6,RDC9  IF NOT *RCIS*/*RCDS* SUBFUNCTION
          LT     B3,B6,RDC1  IF NOT *RCDS* SUBFUNCTION
 
*         CONVERT INTEGER TO F10.3 FORMAT (*RCDS*).
 
          MX4    -48         DATA MASK
          SA3    A5+B1       WORD TO CONVERT
          ZR     B4,RDC4     IF NO CONVERSION TO CLOCK CYCLES
          SB4    RDC3        SET *DSB* RETURN ADDRESS
          SA2    /MONITOR/CPTA  CONVERT QUARTER NANOUNITS TO CLOCK CYCLE
          PX2    X2
          BX6    X3
          NX2    X2
          EQ     DSB         DIVIDE 60 BIT INTEGER
 
*         CONVERT INTEGER(S) TO F10.3 FORMAT (*RCIS*).
 
 RDC1     ZR     B4,RDC2     IF NO SRU CONVERSION
          GT     B4,B3,HNG   IF SRU POINTER .GT. WORD COUNT
          SA2    A5+B4
          MX6    -42
          SA3    /MONITOR/TTH
          BX6    -X6*X2      ISOLATE SRU ACCUMULATOR
          PX6    X6
          FX6    X3*X6       SCALE SRU ACCUMULATOR
          SA6    A2          STORE FOR CONVERSION
 RDC2     ZR     X5,RDC4     IF NO NANOUNITS TO MILLIUNITS CONVERSION
          SB4    X5
          SA3    A5+B4       WORD TO CONVERT
          GT     B4,B6,HNG   IF MILLIUNITS POINTER .GT. WORD COUNT
          SA2    /MONITOR/CPTB  CONVERT QUARTER NANOUNITS TO MILLIUNITS
          SB4    RDC3        SET *DSB* RETURN ADDRESS
          BX6    X3
          EQ     MSB         MULTIPLY 60 BIT INTEGER
 
 RDC3     SA6    A3+         STORE QUOTIENT
          SB6    7           RESTORE B6
 
*         INITIALIZE CONVERSION.  (A1) = OR.  (B6) = CONVERSION COUNT.
 
 RDC4     SA2    RDCA        (X2) = 0.1P48+1
          SX5    1R.         (X5) = DECIMAL POINT
          SA3    RDCB        (X3) = 10.0P
          LX5    18
          MX0    -18         (X0) = FRACTION MASK
 
*         CONVERT ACCOUNTING WORDS.
 
 RDC5     SA1    A1+B1       CHECK NEXT WORD
          BX6    -X4*X1
          SX7    1000
          ZR     X6,RDC8     IF BLANK WORD
          SB4    1R0-1R      (B4) = CONVERSION
          SA4    A3+B1       (X4) = BACKGROUND
          PX1    X6
          SB2    9           SET MAXIMUM NUMBER OF DIGITS PER WORD
          IX7    X6-X7
          SB6    -B5
          PL     X7,RDC6     IF INTEGER PRESENT
          SB4    B0+
          SA4    A4+1
 RDC6     DX6    X2*X1       EXTRACT REMAINDER
          FX1    X2*X1
          UX7    X1          CHECK QUOTIENT
          SB2    B2-B1       DECREMENT CHARACTER COUNT
          LX4    -6          SHIFT ASSEMBLY
          GT     B2,B0,RDC7  IF WORD NOT FULL
          BX7    X7-X7       TERMINATE CONVERSION
 RDC7     SB6    B6+B5       ADVANCE SHIFT COUNT
          FX6    X3*X6       EXTRACT DIGIT
          SX6    X6+B4       CONVERT DIGIT
          IX4    X6+X4
          NZ     X7,RDC6     LOOP TO ZERO QUOTIENT
          LX6    X4,B6       RIGHT JUSTIFY ASSEMBLY
          BX4    -X0*X6      EXTRACT FRACTION
          ZR     X5,RDC8     IF SECOND PASS FOR F20.3 CONVERSION
          IX7    X4+X5       ADD DECIMAL POINT
          LX6    6
          MX4    36
          BX4    X4*X6       EXTRACT INTEGER
          IX6    X4+X7       ADD INTEGER
          SB6    -B5         RESET SHIFT COUNT
          LE     B3,B5,RDC8  IF NOT F20.3 CONVERSION
          SA6    A1+1        STORE WORD FROM FIRST PASS
          SB2    10          RESET NUMBER OF DIGITS PER WORD
          SA4    A3+1        RESET BACKGROUND
          UX7    X1
          SX5    B0+         INDICATE F20.3 FIRST PASS COMPLETE
          BX6    X4
          SB4    1R0-1R      RESET CONVERSION OFFSET
          NZ     X7,RDC6     IF MORE DIGITS TO CONVERT
 RDC8     SA6    A1          STORE CONVERSION
          BX7    X7-X7
          GT     B3,B5,PRG1  IF F20.3 CONVERSION
          SB3    B3-B1       DECREMENT WORD COUNT
          MX4    -30
          NZ     B3,RDC5     IF MORE TO CONVERT
          EQ     PRG1        EXIT AND STORE *OR*
 
*         INCREMENT CURRENT PACKED DATE BY SPECIFIED TERM (*RIDS*).
 
 RDC9     SB6    REPS
          ERRNZ  REPS-RIDS-1 CODE DEPENDS ON VALUE
          GT     B3,B6,HNG   IF ILLEGAL SUBFUNCTION
          EQ     B3,B6,RDC17 IF *REPS* SUBFUNCTION
          SA2    PDTL        GET CURRENT DATE
          AX2    18
          SA5    A5          GET TERM
          MX0    -12
          BX1    -X0*X5
          MX0    -6          UNPACK DATE
          BX3    -X0*X2
          SB3    X3          DAY
          AX2    6
          BX3    -X0*X2
          SB4    X3          MONTH
          AX2    6
          BX2    -X0*X2
          SB5    X2          YEAR
          MX0    -2          MASK FOR LEAP YEAR
 
*         ADVANCE YEAR.
 
 RDC10    SX4    X1-366D     (TERM REMAINING) - (DAYS IN LEAP YEAR)
          NG     X4,RDC14    IF LESS THAN 1 YEAR REMAINING
          SB5    B5+B1       ADD 1 YEAR TO EXPIRATION DATE
          SX3    B5+B1
          SB6    B1+B1
          BX2    -X0*X3
          ZR     X2,RDC11    IF CURRENT YEAR IS A LEAP YEAR
          SX2    X3+B1       YEAR + 1 + LEAP YEAR OFFSET
          BX2    -X0*X2
          NZ     X2,RDC13    IF NEXT YEAR IS NOT A LEAP YEAR
          LE     B4,B6,RDC13 IF BEFORE LEAP DAY
          SX1    X1-1        SUBTRACT 1 DAY TO OFFSET LEAP DAY
          EQ     RDC13       SUBTRACT 1 YEAR FROM TERM
 
 RDC11    GT     B4,B6,RDC13 IF AFTER LEAP DAY
          SX1    X1-1        SUBTRACT 1 DAY TO OFFSET LEAP DAY
 RDC13    SX1    X1-365D     SUBTRACT 1 YEAR FROM TERM
          EQ     RDC10       CONTINUE PROCESSING
 
*         ADVANCE MONTH.
 
 RDC14    SA4    RDCC+B4     GET DAYS IN CURRENT MONTH
          SX7    B4-2
          NZ     X7,RDC15    IF CURRENT MONTH NOT FEBRUARY
          SX2    B5+2
          BX7    -X0*X2
          NZ     X7,RDC15    IF NOT LEAP YEAR
          SX4    X4+B1       ADD LEAP DAY
 RDC15    SX2    B3+
          IX2    X4-X2       DAYS TO END OF CURRENT MONTH
          IX3    X1-X2       SUBTRACT FROM TERM REMAINING
          NG     X3,RDC16    IF NOT ENOUGH TERM REMAINING TO FILL MONTH
          ZR     X3,RDC16    IF TERM EXACTLY FILLS CURRENT MONTH
          SB3    B0+
          SB4    B4+B1       INCREMENT MONTH
          BX1    X3          SET NEW TERM
          SX7    B4-13
          NZ     X7,RDC14    IF NOT END OF YEAR
          SB5    B5+B1       INCREMENT YEAR
          SB4    B1          SET MONTH TO JANUARY
          EQ     RDC14       CONTINUE
 
*         RETURN NEW PACKED DATE.
 
 RDC16    SB3    X1+B3       SET DAYS
          SX6    B5          ADD IN YEAR
          LX6    6
          SX6    X6+B4       ADD IN MONTH
          LX6    6
          SX6    X6+B3       ADD IN DAY
          SA6    A5+B1       SET DATE IN MESSAGE BUFFER WORD
          BX7    X7-X7
          EQ     PRG1        EXIT AND STORE OUTPUT REGISTER
 
*         ENCRYPT PASSWORD (*REPS*).
*
*         THE ENCRYPTION ALGORITHM USED IS A POLYNOMIAL EXPANSION,
*         MODULUS A LARGE PRIME NUMBER, OF THE FORM -
*
*         E = SUM(A(N) * K**B(N))MOD PRIME
*
*         WHERE -
*
*                E     = ENCRYPTED PASSWORD.
*                K     = UNENCRYPTED (PLAINTEXT) PASSWORD.
*                A(N)  = LARGE EXPANSION COEFFICIENT (N=1,6).
*                B(N)  = PRIME EXPANSION EXPONENT (N=1,6).
*                PRIME = LARGE PRIME INTEGER IN THE INTERVAL
*                        (2**41, 2**42-1).
*
*         PROGRAMMING NOTES.
*
*         1.  THIS ALGORITHM MAY BE CUSTOMIZED BY ANY OR ALL
*             OF THE FOLLOWING METHODS -
*
*             A.  CHANGING THE VALUE OF THE PRIME MODULUS,
*                 MAINTAINING THE CORRECT RANGE.
*
*             B.  CHANGING THE NUMBER OF TERMS IN THE EXPANSION
*                 POLYNOMIAL.
*
*             C.  CHANGING THE VALUES OF THE PRIME EXPONENTS.
*
*             D.  CHANGING THE VALUES OF THE COEFFICIENTS.
*
*         2.  THE LENGTH OF THE BIT STRING TO BE ENCRYPTED MAY
*             BE ALTERED TO ANY VALUE N .LE. 48D BY ALTERING
*             THE RANGE OF THE PRIME MODULUS TO ANY VALUE *MOD*
*             SUCH THAT -
*
*               (2**(N-1)) .LE. MOD .LE. (2**(N)-1)
 
 NTERM    EQU    6           NUMBER OF TERMS IN POLYNOMIAL EXPANSION
 
**        TEMPORARY STORAGE LOCATIONS USED BY SUBFUNCTION *REPS*.
 
 
 RDCD     BSS    0           START OF TEMPORARY STORAGE
 EPWD     CON    0           ENCRYPTED PASSWORD
 UPWD     CON    0           UNENCRYPTED PASSWORD
 TMP1     CON    0           TEMPORARY STORAGE
 TMP2     CON    0           TEMPORARY STORAGE
 TMP3     CON    0           TEMPORARY STORAGE
 RDCDL    EQU    *-RDCD      LENGTH OF TEMPORARY STORAGE
          SPACE  4,10
*         PRIME - PRIME IS CHOSEN TO PROVIDE A LARGE PRIME
*         INTEGER IN THE INTERVAL (2**41,2**42-1).
 
 
 PRIM     DATA   00000077777777777561B  (2**42)-143 PRIME MODULUS
 MOD      DATA   17717777777777756100B  PACKED/NORMALIZED PRIME MODULUS
          SPACE  4,10
*         EXPT - TABLE OF PRIME EXPONENTS USED BY SUBFUNCTION *REPS*.
 
 
 EXPT     BSS    0           START OF TABLE
          DATA   1777777777747B  (2**37)-25
          DATA   1777755B        (2**19)-19
          DATA   3
          DATA   2
          DATA   1
          DATA   0
 EXPTL    EQU    *-EXPT
          ERRNZ  EXPTL-NTERM IMPROPER NUMBER OF EXPONENTS
          SPACE  4,10
*         COFT - TABLE OF COEFFICIENTS USED BY SUBFUNCTION *REPS*.
 
 
 COFT     BSS    0           START OF TABLE
          DATA   35216
          DATA   14486
          DATA   29891
          DATA   68607
          DATA   41867
          DATA   14951
 COFTL    EQU    *-COFT
          ERRNZ  COFTL-NTERM IMPROPER NUMBER OF COEFFICIENTS
 
 RDC17    SA1    A5+B1       GET UNENCRYPTED PASSWORD
          MX0    -42
          AX1    18
          BX6    -X0*X1
          SB6    B0+         INITIALIZE ITERATION INDEX
          SA6    UPWD
 
*         CALCULATE THE EXPONENT Y = (Z**N)MOD PRIME, WHERE
*         Y, Z, AND N ARE 42-BIT INTEGERS.
 
 RDC18    SA1    UPWD        GET UNENCRYPTED PASSWORD
          SA2    EXPT+B6     GET EXPONENT
          BX6    X1          SAVE Z = INTEGER
          LX7    X2          SAVE N = WORKING EXPONENT
          SA6    A1+B1       (TMP1) = Z TERM
          ERRNZ  TMP1-UPWD-1 ERROR IF WORDS NOT CONTIGUOUS
          SA7    A6+B1       (TMP2) = N
          ERRNZ  TMP2-TMP1-1 ERROR IF WORDS NOT CONTIGUOUS
          SX6    B1          INITIALIZE Y TERM
          SA6    A7+B1       (TMP3) = Y
          ERRNZ  TMP3-TMP2-1 ERROR IF WORDS NOT CONTIGUOUS
          ZR     X2,RDC23    IF EXPONENT = ZERO
 RDC19    SA3    TMP2        GET N TERM
          SA1    TMP1        GET Z TERM
          AX6    X3,B1       N = N/2
          LX3    59-0
          SA6    A3+         STORE HALVED N TERM
          PL     X3,RDC21    IF N TERM WAS EVEN BEFORE HALVING
          SA2    TMP3        GET Y TERM
          SB3    RDC20       SET RETURN ADDRESS
          EQ     MPY         Y = Z*Y
 
 RDC20    SA6    TMP3        SAVE NEW Y
          SA3    TMP2        CHECK N
          ZR     X3,RDC23    IF CALCULATION COMPLETE
          SA1    TMP1        GET Z TERM
 RDC21    BX2    X1
          SB3    RDC22       SET RETURN ADDRESS
          EQ     MPY         Z = Z*Z
 
 RDC22    SA6    TMP1        SAVE NEW Z TERM
          EQ     RDC19       LOOP
 
*         MULTIPLY COEFFICIENT * EXPONENT.
 
 RDC23    SA2    COFT+B6     GET COEFFICIENT
          SA1    TMP3        GET EXPONENT
          SB3    RDC24       SET RETURN ADDRESS
          EQ     MPY         MULTIPLY BY COEFFICIENT
 
*         CALCULATE THE ENCRYPTED PASSWORD.
 
 RDC24    SA2    EPWD        GET ENCRYPTED PASSWORD
          SA3    PRIM        GET PRIME MODULUS
          IX6    X2+X6       SUM VALUES
          IX1    X6-X3
          NG     X1,RDC25    IF SUM .LT. MODULUS
          BX6    X1
 RDC25    SA6    A2          STORE NEW ENCRYPTED PASSWORD
          SB6    B6+B1       INCREMENT ITERATION INDEX
          SB5    B6-NTERM
          NG     B5,RDC18    IF MORE ITERATIONS REQUIRED
 
*         CLEAR TEMPORARY STORAGE LOCATIONS AND RETURN
*         ENCRYPTED PASSWORD.
 
          SA1    EPWD        GET ENCRYPTED PASSWORD
          SB6    RDCDL-1
          BX6    X1
          LX6    18          LEFT-JUSTIFY OUTPUT
          BX7    X7-X7
          SA6    A5+B1       RETURN ENCRYPTED PASSWORD
 RDC26    SA7    RDCD+B6     CLEAR TEMPORARY STORAGE
          SB6    B6-1
          PL     B6,RDC26    IF MORE WORDS TO CLEAR
          EQ     PRG1        EXIT AND SET OUTPUT REGISTER
 
 RDCA     CON    0.1P48+1    EXTRACT REMAINDER
 RDCB     CON    10.0P       EXTRACT DIGIT
          CON    10H
          CON    10H     0000
 
 RDCC     EQU    *-1         TABLE OF DAYS IN MONTH
          CON    31          JANUARY
          CON    28          FEBRUARY
          CON    31          MARCH
          CON    30          APRIL
          CON    31          MAY
          CON    30          JUNE
          CON    31          JULY
          CON    31          AUGUST
          CON    30          SEPTEMBER
          CON    31          OCTOBER
          CON    30          NOVEMBER
          CON    31          DECEMBER
 RTC      SPACE  4,20
**        RTC - RESERVE TRACK CHAIN.
*
*         ENTRY  (A5) = PPU OUTPUT REGISTER ADDRESS.
*
*         EXIT   (X7) = FIRST TRACK IN BYTE 4, IF TRACKS ASSIGNED.
*                (X7) = REASON CODE IN BYTE 3, IF NO TRACKS ASSIGNED.
*
*         USES   X - ALL.
*                B - 2, 3, 4, 5, 6, 7.
*                A - 0, 1, 2, 3, 4, 6, 7.
*
*         CALLS  CCP1, CTR.
 
 
 RTC      BSS    0           ENTRY
          BX2    X1          CHECK EQUIPMENT SPECIFIED
          MX0    -9
          LX2    24
          BX3    -X0*X2
          SB3    RTC7        SET *CTR* RETURN
          NZ     X3,CTR      IF EQUIPMENT SPECIFIED
          AX2    48
          SB4    B0          (B4) = FIRST UNRESTRICTED DEVICE
          SB2    X2-MXRS
          PL     B2,HNG      IF ILLEGAL DEVICE SELECTION
          TA1    X2,MSA      READ DEVICE SELECTION BITS
          TA0    EQDE,EST    (A0) = FWA OF EST
          UX3,B5 X1          (B5) = CURRENT EQUIPMENT TO CHECK
          MX0    13          (X0) = MASK TO CLEAR CURRENT SELECTION
          SX2    X5          (X2) = SECTORS REQUESTED
          PL     X2,RTC0     IF SECTORS REQUESTED FIELD GT 0
          SX6    X2+1        CHECK FOR -1 IN SECTORS REQUESTED FIELD
          MX7    -18
          ZR     X6,RTC0     IF ALL AVAILABLE TRACKS REQUESTED
          BX2    -X7*X2      SET SECTORS REQUESTED TO POSITIVE NUMBER
 RTC0     MX7    -12
          SB2    1000B-1777B (B2) = DALL ACTIVITY TO BEAT
          PX6    X7,B0       (X6) = TRACK LIMIT REJECT
          LX5    59-23
          SB3    0-1777B     (B3) = DALL ACTIVITY, IMMEDIATE SELECTION
          PL     X5,RTC3     IF NO ACCESS LEVEL SELECTION
          TEQ    (/PROGRAM/RTC1,OSSM,/PROGRAM/RTC3)
 
 RTC1     LX5    -59+23-18   EXTRACT ACCESS LEVEL SELECTION REQUIREMENT
          MX6    -3          (X6) = -7 = ACCESS LEVEL REJECT CODE
          BX4    -X5+X6
          SB6    X4          (B6) = - ACCESS LEVEL REQUESTED
          EQ     RTC3        ENTER SELECTION LOOP
 
 RTC2     SA3    X5+PFGL     READ DEVICE ACCESS LEVEL LIMITS
          LX3    -6
          BX4    -X6*X3      UPPER ACCESS LEVEL LIMIT
          SX4    X4+B6       NEGATIVE IF ACCESS LEVEL EXCEEDED
          LX3    -3
          BX3    -X6*X3
          SB7    B6-B1
          SX3    X3+B7
          BX4    -X3+X4
          UX6,B7 X6
          PX6    X6,B0       SET DEVICE FOUND (TRACK LIMIT REJECT)
          PL     X4,RTC4     IF REQUESTED ACCESS LEVEL WITHIN LIMITS
          PX6    X6,B7       RESET TO PREVIOUS REJECT REASON
 
*         DEVICE SEARCH LOOP.
 
 RTC3     AX5    X0,B5       FIND NEXT EQUIPMENT
          BX3    -X5*X1
          PX5    X3
          NX4,B5 X5
          ZR     X3,RTC6     IF END OF PASS ON EQUIPMENTS
          IFEQ   ESTE,2,1
          SB7    B5+B5       COMPUTE RELATIVE EST ADDRESS (ESTE = 2)
          IFEQ   ESTE,3,2
          SB7    B5+B5       COMPUTE RELATIVE EST ADDRESS (ESTE = 3)
          SB7    B7+B5
          IFEQ   ESTE,4,2
          SB7    B5+B5       COMPUTE RELATIVE EST ADDRESS (ESTE = 4)
          SB7    B7+B7
          IFEQ   ESTE,5,3
          SB7    B5+B5       COMPUTE RELATIVE EST ADDRESS (ESTE = 5)
          SB7    B7+B7
          SB7    B7+B5
          IFEQ   ESTE,6,3
          SB7    B5+B5       COMPUTE RELATIVE EST ADDRESS (ESTE = 6)
          SB7    B7+B5
          SB7    B7+B7
          IFEQ   ESTE,7,4
          SB7    B5+B5       COMPUTE RELATIVE EST ADDRESS (ESTE = 7)
          SB7    B7+B5
          SB7    B7+B7
          SB7    B7+B5
          IFEQ   ESTE,8,3
          SB7    B5+B5       COMPUTE RELATIVE EST ADDRESS (ESTE = 8)
          SB7    B7+B7
          SB7    B7+B7
          ERRPL  ESTE-9      CODE DOES NOT HANDLE EST SIZE .GT. 8
          SA4    A0+B7       READ EST ENTRY
          BX5    -X7*X4
          LX4    59-54
          LX5    3
          NG     X4,RTC3     IF UNAVAILABLE DEVICE
          LE     B6,B0,RTC2  IF ACCESS LEVEL VALIDATION REQUIRED
 RTC4     SA3    X5+DALL     READ ACTIVITY BYTE
          UX3,B7 X3
          SA4    X5 + TDGL   READ TRACK COUNT
          ERRNZ  TDGL
          GE     B7,B2,RTC3  IF NOT LESS THAN PREVIOUS LEAST ACTIVITY
          SA3    X5+MDGL     READ SECTORS PER TRACK
          BX4    -X7*X4
          BX3    -X7*X3
          IX4    X4*X3
          IX4    X4-X2
          SA3    X5+ACGL
          NG     X4,RTC3     IF NOT ENOUGH TRACKS
          LX3    59-4
          NG     X3,RTC3     IF ERROR IDLE SET
          SB4    B5          SET CURRENT EQUIPMENT AS BEST
          SB2    B7          SET CURRENT ACTIVITY AS BEST
          GT     B2,B3,RTC3  IF ACTIVITY PROHIBITS IMMEDIATE SELECTION
 RTC5     SA1    A1          UPDATE LAST EQUIPMENT SELECTED
          PX6    X1,B4
          SA6    A1
          SA5    A5          REREAD OUTPUT REGISTER
          LX7    24
          SX4    B4          MERGE EQUIPMENT IN REQUEST
          BX3    -X7*X5      ORIGINAL DEVICE SELECTION
          BX5    X7*X5
          LX4    36
          AX3    24          CHECK ORIGINAL DEVICE SELECTION
          SX2    X3-ROLS
          SX3    X3-SROS
          IX3    X2*X3
          NZ     X3,RTC5.2   IF NEITHER ROLLOUT NOR SECONDARY ROLL
          TA3    ROTS,SDA    UPDATE ROLLOUT STATISTICS
          TA2    NROS,SDA
          SX0    B1
          SX1    X5
          IX6    X3+X0       COUNT ROLLOUT
          IX7    X2+X1       COUNT SECTORS ROLLED
          SA6    A3
          SA7    A2
          TX7    A1-SROS,-MSA  CHECK FILE ALLOCATION
          NZ     X7,RTC5.2   IF NOT SECONDARY ROLLOUT DEVICE
          TA3    SOTS,SDA    UPDATE SECONDARY ROLLOUT STATISTICS
          TA2    NSRS,SDA
          IX6    X3+X0       COUNT SECONDARY ROLLOUT
          IX7    X2+X1       COUNT SECONDARY SECTORS ROLLED
          SA6    A3
          SA7    A2
 RTC5.2   BX5    X4+X5
          BX7    X5
          UX1    X5
          SA7    A5          UPDATE OUTPUT REGISTER
          SB3    RTC7        SET *CTR* RETURN
          SB6    B1+         SET *CTR* ENTRY CONDITION
          TEQ    (/ISD/RTC,ISD,/PROGRAM/CTR)  CHECK TRACK REQUEST
 
*         PROCESS END OF PASS ON EQUIPMENTS.
 
 RTC6     UX5,B5 X1          CHECK FOR WRAP ON SELECTION WORD
          AX4    X0,B5
          PX1    X5          INITIALIZE FOR EQUIPMENT WRAP
          SB5    B0
          BX1    X4*X1       CLEAR EQUIPMENTS ALREADY CHECKED
          BX4    X4-X0
          NZ     X4,RTC3     IF SECOND PASS ON EQUIPMENTS NEEDED
          SB7    100B-1777B  UNRESTRICTED DEVICE THRESHOLD
          LT     B2,B7,RTC5  IF UNRESTRICTED EQUIPMENT FOUND
          SA4    A1          REREAD SELECTION
          UX4    X4
          TB7    A1-SROS,-MSA
          NZ     B7,RTC6.1   IF NOT SECONDARY ROLLOUT
          TA1    ROLS,MSA
          BX1    -X4*X1      CLEAR DEVICES ALREADY CHECKED
          UX3,B5 X1
          NZ     X3,RTC3     IF ROLLOUT DEVICES PRESENT
 RTC6.1   TA1    MSA
          BX1    -X4*X1
          UX3,B5 X1
          NZ     X3,RTC3     IF TO TRY TEMP DEVICES
          SA1    A4          RESET DEVICE TO UPDATE EQUIPMENT FOR
          NZ     B4,RTC5     IF EQUIPMENT FOUND
          SX7    10000B      TRACK LIMIT REJECT CODE
          AX6    12          CHECK REJECT REASON
          NZ     X6,RTC6.2   IF NOT ACCESS LEVEL REJECT - EXIT
          LX7    1
 RTC6.2   SB5    PRG
          EQ     CSM1        CHECK FOR STORAGE MOVE
 
*         CHECK TRACKS AVAILABLE.
 
 RTC7     SA4    A3+MDGL-TDGL  READ SECTOR LIMITS
          BX6    -X5*X3      TRACKS AVAILABLE
          BX4    -X5*X4      MINUMUM SECTOR LIMIT
          NZ     X7,RTC7.1   IF NOT REQUESTING ONE TRACK
          SX7    B1+         SET ONE SECTOR REQUESTED
          EQ     RTC8        COMPUTE REQUESTED TRACKS
 
 RTC7.1   PL     X7,RTC8     IF NOT REQUESTING ALL TRACKS
          SX2    X7+B1
          MX5    -18
          BX7    -X5*X7      SET SECTORS REQUESTED TO POSITIVE NUMBER
          NZ     X2,RTC8     IF NOT REQUESTING ALL TRACKS
 
          IX7    X6*X4       REQUEST ALL TRACKS ON DEVICE
 RTC8     PX2    X4          COMPUTE REQUESTED TRACKS
          PX5    X7
          NX2    X2
          FX2    X5/X2
          UX2,B2 X2
          LX2    X2,B2
          IX5    X2*X4       COMPUTE SECTORS IN LAST TRACK
          IX7    X7-X5
          SA7    RTCA        SAVE REMAINDER
          SX5    -1
          ZR     X7,RTC9     IF MULTIPLE OF SECTOR LIMIT
          SX2    X2+1        INCREASE TRACK COUNT BY ONE
 RTC9     SB4    X2          REQUESTED TRACKS
          IX3    X3-X2       DECREMENT TRACKS REMAINING
          SX7    B1
          IX6    X6-X2       DECREMENT TRACKS REMAINING
          LX7    47
          NG     X6,CCP1     IF TRACKS NOT AVAILABLE
          MX6    -11
          SB7    -48         (B7) = -48 = NORMALIZE BIAS
          LX3    -12
          SB3    B6-B1       FIRST WORD ADDRESS - 1 OF TRT
          BX2    -X6*X3      FIRST FREE TRACK POINTER
          MX5    -4          (X5) = -17B = RESERVATION BIT MASK
          BX3    X6*X3       CLEAR FIRST FREE TRACK POINTER
          SA2    X2+B3       SET START OF TRT SEARCH
          SA0    TMSK-1      SET SCRATCH WORD ADDRESS
          SA4    B0+         SET NO LINK WORD ADDRESS
 
*         CLEAR LINK BYTE IN CURRENT TRACK.
 
          ZR     X1,RTC10    IF NO CURRENT TRACK
          MX2    -2
          BX0    -X6*X1      CURRENT TRACK
          BX2    -X2*X1
          AX0    2
          SB2    X2+56       RESERVATION BIT SHIFT COUNT
          LX2    2
          SB3    X2
          LX2    1
          SA4    X0+B6       READ TRT WORD OF CURRENT TRACK
          SB3    X2+B3       SET LINK BIT SHIFT COUNT
          LX2    X4,B2       POSITION RESERVATION BIT
          SA0    A4          SET LINK ADDRESS
          LX0    X4,B3       POSITION LINK BIT
          SB3    B3+B7       SET LINK SHIFT COUNT
          BX2    -X0*X2
          AX6    X6,B3       POSITION CLEARING MASK
          MX0    1           SET NO MRT PROCESSING
          PL     X2,HNG      IF NOT RESERVED OR IF LINKED
          BX6    X6*X4
          SA6    A4
 
*         SEARCH FOR FIRST FREE TRACK.
 
 RTC10    SA2    A2+B1       SEARCH FOR FREE TRACK
          BX6    X2+X5
          ZR     X6,RTC10    IF NO FREE TRACK
          SX4    A2-B6       COMPUTE TRACK NUMBER
          NX6,B2 X6
          LX4    2
          SB6    4000B-44+X4
          SX4    B6+B2       TRACK NUMBER
          BX3    X3+X4       SAVE FIRST TRACK ASSIGNED
          NG     X0,RTC13    IF NO MRT BIT TO SET
          TEQ    (/ISDMMF/SMB,ISDMMF,/PROGRAM/HNG)  SET MRT BIT
 
*         TRT SEARCH AND LINK LOOP.
 
 RTC11    SA2    A2+B1       NEXT TRT WORD
          SB6    B6+4        INCREMENT BASE TRACK NUMBER
          BX6    X2+X5       CHECK TRACKS RESERVED
 RTC12    ZR     X6,RTC11    IF ALL TRACKS RESERVED
          NX6,B2 X6          (B2) = BYTE NUMBER + 44
          SX4    B6+B2       TRACK NUMBER
 RTC13    AX6    X7,B2       POSITION RESERVATION BIT
          BX6    X2+X6       RESERVE TRACK
          SA6    A2
          SA1    A0          READ PREVIOUS RESERVATION
          AX6    X4,B3       POSITION LINK BYTE
          BX6    X6+X1       MERGE LINK BYTE
          SX4    B2+B7       BYTE NUMBER - 4
          SA6    A1
          LX4    2
          SB4    B4-B1       DECREMENT TRACK COUNT
          SB3    X4
          SA2    A2          RE-READ RESERVATION WORD
          LX4    1
          SA0    A2          SET LINK ADDRESS
          SB3    X4+B3       SET LINK SHIFT COUNT
          BX6    X2+X5
          NZ     B4,RTC12    IF MORE TRACKS REQUESTED
 
*         UPDATE LAST TRACK BYTE (EOI SECTOR).
 
          SA1    RTCA        GET REMAINDER
          NZ     X1,RTC13.1  IF REQUEST NOT MULTIPLE OF SECTOR LIMIT
          SA1    A3+MDGL-TDGL  GET SECTOR LIMIT
          MX7    -12
          BX1    -X7*X1      SECTOR LIMIT
 RTC13.1  SX7    B1          COMPUTE REMAINING SECTOR COUNT
          IX1    X1-X7
          AX7    X1,B3       POSITION TO TRACK BYTE IN TRT
          BX7    X7+X2
          SA7    A2          UPDATE TRACK BYTE
          LX1    12
          SX7    B2+B6       TRACK NUMBER
          LX7    24
          BX7    X1+X7       PRESET RESPONSE
 
*         UPDATE FIRST FREE TRACK AND RETURN FIRST TRACK ASSIGNED.
 
          MX4    -11
          SA1    A3+TRLL-TDGL  SET FWA OF TRT
          SB6    X1
          SB4    A4          SET LINK WORD ADDRESS
          BX1    -X4*X3
          BX6    X4*X3
          SX5    A2-B6       FIRST FREE TRACK
          SX0    X1+4000B    FIRST TRACK
          BX7    X0+X7       INSERT INTO RESPONSE TO PP
          BX6    X6+X5       MERGE FIRST FREE TRACK BYTE
          AX1    2
          SB3    A2
          LX6    12
          SA2    A5          RE-READ REQUEST
          LT     B4,B3,RTC14 IF LINK WORD BEFORE LAST WORD TO UPDATE
          SX5    B4-B6       UPDATE UP TO LINK WORD
 RTC14    MX4    -9          SET EST ORDINAL
          SA6    A3          STORE UPDATED *TDGL*
          LX4    36
          BX2    -X4*X2
          SX5    X5+B1       SET LWA+1 OF TRT TO UPDATE
          BX7    X2+X7       RETURN FIRST TRACK ASSIGNED
          EQ     CCP1        CHECK FOR DEVICE CHECKPOINT REQUESTED
 
 
 RTCA     CON    0           REMAINDER
 STB      SPACE  4
**        STB - SET TRACK BIT.
*         ENTERED FROM BOTH MONITOR AND PROGRAM MODE.
*
*         ENTRY  (A5) = PP OUTPUT REGISTER ADDRESS.
*         STB    ENTRY FROM PROGRAM MODE.
*         STB1   ENTRY FROM MONITOR MODE.
*         (B5)   EXIT ADDRESS IF ENTERED AT *STB1*.
*
*         EXIT   NONE.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 4, 5.
*                A - 3, 4, 6, 7.
*
*         CALLS  CCP, CTR.
 
 
 STB      SX4    X1
          LX4    -14
          SA2    X4+/MONITOR/TSTB  READ OPTION TABLE
          NG     X4,STB1     IF SECOND ENTRY IN OPTION TABLE WORD
          LX2    30
 STB1     SB3    X2          SET *CTR* RETURN
          UX2,B6 X2          SET *CTR* PARAMETER
          EQ     CTR         CHECK TRACK REQUEST
 
 STB2     SX7    STIS*10000B INTERLOCK IQFT TRACK
          ZR     X1,/MONITOR/STB3  IF NO IQFT TRACK
 
          SUBFUN STBM,(STFS,CTFS,STIS,CTIS,SPFS,CPFS)
          AX4    X5,B1       -3777B MASK
          BX1    -X4*X1      TRACK NUMBER
          MX3    -2
          SX5    B1
          BX3    X3+X1       BYTE NUMBER - 3
          LX7    -13
          SB3    X3          SET RESERVATION BIT SHIFT COUNT
          LX1    -2
          SX2    X7
          AX5    X5,B3       POSITION RESERVATION BIT
          LX2    2
          SA4    B6+X1       READ TRT WORD
          SB3    X2          SET TRACK BIT SHIFT COUNT
          BX2    X5*X4       CURRENT VALUE OF RESERVATION BIT
          LX5    X5,B3       POSITION TRACK BIT
          AX7    59          (X7) = 0 FOR SET, -0 FOR CLEAR OPTION
          BX6    X4-X5       COMPLEMENT TRACK BIT
          BX4    X5*X4       CURRENT VALUE OF TRACK BIT
          BX5    -X7*X5      NON-ZERO IF SET REQUEST
          BX4    X5-X4       ZERO IF BIT ALREADY SET/CLEAR
          ZR     B3,STB8     IF FLAW REQUEST
          ZR     X2,STB9     IF TRACK NOT RESERVED
          ZR     X4,STB7     IF BIT ALREADY SET/CLEAR
          AX4    8
          SX3    B1
 STB4     NZ     X4,STB5     IF INCREMENT/DECREMENT OF PF COUNT
          BX7    X7-X7
          SA6    A4          STORE TRT WORD
          NG     X0,CCP1     IF NOT SHARED DEVICE
          TEQ    (/ISDMMF/STB10,ISDMMF,/MONITOR/HNG1)
 
*         INCREMENT/DECREMENT PRESERVED FILE COUNT.
 
 STB5     BX7    X7-X3       (X7) = 1 IF INCREMENT, -1 IF DECREMENT
          LX3    24+11
          SA2    A3+B1       READ *ACGL* WORD
          LX7    24
          IX7    X2+X7       ADJUST COUNT
          BX4    -X3+X7      CHECK FOR OVERFLOW/UNDERFLOW
          ZR     X4,STB4     IF OVERFLOW/UNDERFLOW
 STB6     SA7    A2          STORE UPDATED COUNTS
          BX4    X4-X4
          EQ     STB4
 
 STB7     ZR     X5,/MONITOR/HNG1  IF CLEARING AN ALREADY CLEARED BIT
          SX7    B1
          SX3    B1
          LX7    36
          MX5    1           SET NO UPDATE OF TRT IN ECS
          EQ     CDI         RELEASE DEVICE INTERLOCK
 
*         PROCESS FLAW REQUEST.
 
 STB8     ZR     X4,STB7     IF BIT ALREADY SET/CLEAR
          SA2    X3+TMSK+3
          LX3    2           COMPUTE BYTE SHIFT COUNT
          BX5    -X2*X6      MASK OUT ALL FIELDS FOR THIS TRACK
          SB4    X3
          LX3    1
          SB4    B4+X3
          MX4    -11
          SA2    A3          REREAD *TDGL*
          LX4    12
          BX2    X4*X2       CLEAR FIRST FREE TRACK POINTER
          AX4    X4,B4       POSITION FLAW STATUS BYTE
          BX6    -X4-X6      COMPLIMENT FLAW STATUS
          BX4    -X4*X7
          BX5    X5-X4
          AX5    4           SHIFT OFF RESERVATION BITS
          NZ     X5,/MONITOR/HNG1  IF BAD TRACK
          SX3    B1
          BX7    -X7-X3
          IX7    X2+X7
          EQ     STB6
 
 STB9     SA4    A5          CHECK RETURN ON TRACK NOT RESERVED
          SX7    B1+B1
          MX5    1           SET NO TRT UPDATE
          LX4    59-46
          PL     X4,/MONITOR/HNG1  IF NO RETURN
          SX3    B1
          LX7    36
          EQ     CDI         CLEAR DEVICE INTERLOCK
          TITLE  PROGRAM MODE SUBROUTINES.
 APS      SPACE  4,10
**        APS - ASSIGN PP (PROGRAM MODE).
*
*         ENTRY  (X1) = PP REQUEST.
*                (B3) = EXIT ADDRESS.
*
*         EXIT   (X1) = ADDRESS OF COMMUNICATION BUFFER.
*                (X1) = 0  IF NO BUFFER AVAILABLE.
*                (X6) = PP REQUEST.
*
*         USES   X - 1, 6, 7.
*                A - 1, 6.
*
*         CALLS  /MONITOR/ACB.
 
 
 APS      SX6    -B1         SET PP REQUEST TO MONITOR MODE
          BX7    X1          SAVE PP REQUEST
          SA6    PX
          SB3    -B3         SET *APS* CALL TO *ACB*
          EQ     /MONITOR/ACB  ASSIGN COMMUNICATION BUFFER
 
 APS1     SB3    -B3         RESET RETURN ADDRESS
          BX6    X1          PARAMETER WORD
          ZR     X1,APS2     IF NO BUFFER AVAILABLE
 
          MJ                 EXCHANGE TO MONITOR MODE
 
          ZR     X6,APS3     IF NO PP ASSIGNED
 APS2     BX6    X7          RESTORE PP REQUEST
          JP     B3          RETURN
 
 APS3     SA6    X1          RELEASE COMMUNICATION BUFFER
          BX1    X1-X1       CLEAR RESPONSE
          EQ     APS2        EXIT
 CCP      SPACE  4
**        CCP - CHECK FOR CHECKPOINT REQUESTED.
*
*         ENTRY  (X7) = STATUS TO RETURN TO OR.
*                (X1) = FIRST WORD OF TRT TO UPDATE.  (MSD ONLY)
*                (X5) = LAST WORD + 1 OF TRT TO UPDATE.  (MSD ONLY)
*                (B4) = TRT LINK WORD TO UPDATE.  (MSD ONLY)
*                (B5) = EXIT ADDRESS.
*                (B6) = STARTING ADDRESS OF TRT.
*                (A3) = ADDRESS OF TDGL WORD OF MST.
*                (A5) = OR ADDRESS.
*                BIT 11 SET IN OR+1 INDICATES CHECKPOINT REQUESTED.
*
*         EXIT   EXITS TO CDI.
*
*         USES   X - 2, 3, 4, 6.
*                A - 2, 6.
 
 
 
*         ENTERED HERE FROM MONITOR MODE.
 
 CCP1     SA2    A5
          SA4    A3+SDGL-TDGL  CHECK FOR ISHARED DEVICE
          SX3    B1
          LX2    12          POSITION CHECKPOINT REQUESTED BIT
          BX2    -X4*X2
          PL     X2,CDI      IF ISHARED OR NO CHECKPOINT REQUESTED
          SA2    A3+STLL-TDGL  READ MST WORD
          SX4    B1+
          LX4    50
          BX6    X2+X4       SET CHECKPOINT BIT
          SA6    A2+
*         EQ     CDI         CLEAR DEVICE INTERLOCK
 CDI      SPACE  4
**        CDI - CLEAR DEVICE INTERLOCK.
*
*         ENTRY  (X1) = FIRST WORD OF TRT TO UPDATE.  (MSD ONLY)
*                (X3) = 1.
*                (X5) = LAST WORD + 1 OF TRT TO UPDATE.  (MSD ONLY)
*                (X7) = WORD TO BE STORED IN OUTPUT REGISTER.
*                (B4) = TRT LINK WORD TO UPDATE.  (MSD ONLY)
*                (B5) = EXIT ADDRESS.
*                (B6) = START OF TRT.
*                (A3) = ADDRESS OF MST IN CM.
*                (A5) = OUTPUT REGISTER ADDRESS.
*
*         EXIT   (OR) = (X7) = STATUS RESPONSE.
 
 
 CDI      SA4    A3+SDGL     READ SDGL WORD OF MST
          BX6    -X3*X4      RELEASE MST INTERLOCK
          AX4    36
          TNG    X6,(/ISD/CDI,ISD,/MONITOR/HNG1)  IF ISHARED
          TNZ    X4,(/PROGRAM/CDI1,MMF,/LSPMMF/CDI)  IF MMF DEVICE
          SA6    A4+         STORE *SDGL*
*         EQ     CSM1        CHECK FOR STORAGE MOVE
 CSM      SPACE  4,15
**        CSM - CHECK FOR STORAGE MOVE.
*
*         ENTRY  (X7) = WORD TO BE STORED IN OUTPUT REGISTER.
*                (B5) = EXIT ADDRESS, IF ENTERED AT *CSM1*.
*                (A5) = OUTPUT REGISTER ADDRESS.
*
*         EXIT   OUTPUT REGISTER STORED.
*                (X7) = VALUE STORED IN OUTPUT REGISTER.
*
*         USES   X - 2, 3, 6, 7.
*                A - 2, 3, 7.
*                B - 5.
 
 
*         ENTRY WITH RETURN ADDRESS SPECIFIED BY CALLER.
 
 CSM1     TX6    A5-1,-SP    IGNORE PSEUDO-PP
          MX2    12          IGNORE NONZERO OUTPUT REGISTERS
          BX6    -X6+X7
          TX3    A5-1,-FP
          BX2    X2*X6
          LX3    PPXES-PPCES
          NZ     X2,CSM2     IF PSEUDO-PP OR FUNCTION PRESENT
          TA3    X3+ACPP,FPX GET CP/PCP ASSIGNMENT
          SA2    CMCL
          BX3    X3-X2
          AX3    48
          NZ     X3,CSM2     IF NO MOVE REQUEST FOR CP/PCP
          SX3    PRLM
          LX3    48
          BX7    X3+X7       SET *PRLM* IN OUTPUT REGISTER
 CSM2     SA7    A5          STORE OUTPUT REGISTER
          JP     B5          EXIT
 
 CSM      BSS    0           ENTRY
          SB5    PPRX        SET RETURN ADDRESS
          EQ     CSM1        CHECK FOR STORAGE MOVE
 CTR      SPACE  4,35
**        CTR - CHECK TRACK REQUEST.
*         MAY BE USED FROM PROGRAM OR MONITOR MODE.
*
*         ENTRY  (X1) = REQUEST WORD.
*T, X1           12/  0,12/  EQ,12/  TK,12/  ,12/
*                EQ = EST ORDINAL.
*                TK = TRACK NUMBER.
*                (B3) = EXIT ADDRESS.
*                (B5) = EXIT ADDRESS IF ILLEGAL REQUEST FOUND.
*                       NEEDED IF ENTERED AT *CTR1*.
*                (B6) = 0 IF NOT TO INTERLOCK MST/TRT.
*                (B6) .NE. 0 IF TO INTERLOCK MST/TRT AND
*                            READ TRT FROM ECS. (SHARED DEVICE)
*
*         EXIT   (X0) .LT. 0 IF NOT SHARED DEVICE
*                (X0) = 12/TRT LENGTH + 2000B, 48/ECS ADDRESS OF MRT.
*                       (FOR ISD, ECS ADDRESS = 0.)
*                (X1) = BYTE 2 OF REQUEST WORD.
*                (X2) = BYTE 3 OF REQUEST WORD.
*                (X3) = TDGL WORD OF MST.
*                (X5) = -7777B.
*                (X7) = LOWER 18 BITS OF REQUEST WORD. (SIGN EXTENDED)
*                (B6) = ADDRESS OF FIRST WORD OF TRT.
*                (A3) = ADDRESS OF TDGL WORD OF MST.
*                (A4) = ADDRESS OF SDGL WORD OF MST.
*                HANG PPU IF NOT LEGAL MASS STORAGE DEVICE.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                B - 5, 6.
*                A - 3, 4.
*
*         CALLS  REJ, SDI.
 
 
 CTR      SB5    PRG         SET EXIT ADDRESS
 
*         (B5) = EXIT ADDRESS IN CASE OF ERROR DETECTED.
 
 CTR1     LX1    24          POSITION EQUIPMENT FIELD
          MX3    -9
          MX2    -6
          BX7    -X3*X1      EST ORDINAL
          CX4    X7,EST      CONVERT EST ORDINAL TO OFFSET
          MX5    -12
          TA4    X4+EQDE,EST READ EST ENTRY
          TX6    X7,-ESTL
          BX3    -X5*X4      MST ADDRESS/10B
          BX0    X4*X6
          ZR     X7,CTR1.0   IF REQUEST FOR *RD* DEVICE
          PL     X0,/MONITOR/HNG1  IF NOT *MS* OR OUT OF EST
 CTR1.0   LX3    3
          LX1    24
          SA4    X3+SDGL     CHECK SHARED STATUS
          BX6    -X2*X4      MACHINE INTERLOCK FIELD
          AX4    36
          SA3    X3+TDGL
          TNG    X4,(/ISD/CTR3,ISD,/MONITOR/HNG1)  IF ISHARED
          TNZ    X4,(/PROGRAM/SDI,MMF,/LSPMMF/SDI)  IF MMF SHARED
          ZR     B6,CTR2     IF NOT TO INTERLOCK MST/TRT
 
*         INTERLOCK MST/TRT.
 
 CTR1.1   SA4    A4          **** PERFORM IN 1 WORD ****
          SX6    B1          **** PERFORM IN 1 WORD ****
          BX6    X4+X6       **** PERFORM IN 1 WORD ****
          SA6    A4          **** PERFORM IN 1 WORD ****
          BX2    X6-X4
          ZR     X2,REJ      IF PREVIOUSLY INTERLOCKED
 CTR2     BX2    -X5*X1
          LX1    12
          SA3    A3+TRLL-TDGL  SET FWA OF TRT
          SB6    X3
          SX7    X1
          LX1    -24         POSITION BYTE 2
          BX1    -X5*X1
          SA3    A3+TDGL-TRLL  RE-READ *TDGL*
          JP     B3          RETURN
 HNG      SPACE  4
**        HNG - HANG PPU.
*         LEAVE PPU OUTPUT REGISTER SET, SET PACKED TIME AND DATE IN
*         LAST WORD OF MESSAGE BUFFER, AND DISPLAY MESSAGE.
*
*         ENTRY  (A5) = PPU OUTPUT REGISTER ADDRESS.
*                (/MONITOR/T1) = (B2) TO BE RESTORED IF MONITOR MODE.
*
*         EXIT   EXITS TO *PRG*.
 
 
 HNG      RJ     /MONITOR/SVR  SAVE REGISTERS
          SA2    A5
          LX2    59-58       CHECK MONITOR MODE CALL
          SB5    PRGX
          NG     X2,/MONITOR/HNG2  IF IN PROGRAM MODE
          SA2    /MONITOR/T1 RESTORE (B2)
          SB2    X2
          JP     /MONITOR/HNG0  HANG PP
 DSB      SPACE  4,30
**        DSB - DIVIDE 60 BIT INTEGER.
*
*         ENTRY  (X6) = DIVIDEND.
*                (X2) = DIVISOR.
*                (B4) = RETURN ADDRESS.
*
*         EXIT   (X6) = QUOTIENT.
*
*         USES   X - 1, 2.
*
*         CALLS  MSB.
 
 
 DSB      SX1    B1          FORM RECIPROCAL
          PX1    X1
          NX1    X1
          RX2    X1/X2
          EQ     MSB         MULTIPLY 60 BIT INTEGER
 MPY      SPACE  4,15
**        MPY - CALCULATE THE PRODUCT Z = (X*Y)MOD PRIME.
*
*         ENTRY  (X1) = INTEGER (X).
*                (X2) = INTEGER (Y).
*                (B3) = RETURN ADDRESS.
*
*         EXIT   (X6) = INTEGER RESULT.
*
*         USES   X - ALL.
*                A - 3.
*                B - 5.
 
 
 MPY      PX1    X1          PACK AND NORMALIZE X AND Y
          PX2    X2
          NX1    X1          (X1) = D1
          NX2    X2          (X2) = D2
 
*         CALCULATE DX = D1*D2.
 
          SA3    MOD
          FX7    X1*X2
          DX6    X1*X2
 
*         CALCULATE IX = DX/MOD.
 
          BX0    X3
          SX1    B0+
          FX2    X7/X0
          FX5    X2*X0
          FX4    X7-X5
          DX5    X7-X5
          NX4    X4
          FX5    X5+X4
          DX4    X2*X0
          FX4    X6-X4
          FX5    X5+X4
          FX1    X2*X1
          FX4    X5-X1
          FX5    X4/X0
          FX1    X2+X5
          NX1    X1
          DX2    X2+X5
          FX4    X2+X1
          UX4,B5 X4
          LX3    X4,B5
          PX3    X3          (X3) = IX
 
*         CALCULATE DY = IX*MOD.
 
          DX1    X3*X0
          FX2    X3*X0
 
*         CALCULATE Z = DX-DY.
 
          FX3    X7-X2
          DX4    X7-X2
          FX5    X6-X1
          NX0    X3
          FX1    X4+X5
          FX3    X0+X1
          NX6    X3
          DX5    X0+X1
          NX5    X5
          FX6    X6+X5
          UX6,B5 X6
          LX6    X6,B5       (X6) = Z
          JP     B3          RETURN
 MSB      SPACE  4,10
**        MSB - MULTIPLY 60 BIT INTEGER.
*
*         ENTRY  (X6) = 60 BIT INTEGER MULTIPLICAND.
*                (X2) = FLOATING POINT MULTIPLIER.
*                (B4) = RETURN ADDRESS.
*
*         EXIT   (X6) = PRODUCT.
*
*         USES   X - 1, 6, 7.
*                B - 6.
 
 
 MSB      UX7    X6
          MX1    12
          PX7    X7
          BX1    X1*X6       MULTIPLY TOP 12 BITS OF INTEGER
          NX7    X7
          AX1    12
          RX7    X7*X2
          PX1    X1
          RX1    X1*X2
          UX7,B6 X7
          LX7    B6
          UX1,B6 X1
          SB6    B6+12
          LX1    B6
          IX6    X1+X7       MERGE PARTIAL PRODUCTS
          JP     B4          RETURN
 REJ      SPACE  4
**        REJ - REJECT FUNCTION REQUEST.
*
*         IF STORAGE MOVE IS REQUESTED FOR THE CONTROL POINT OR
*         PSEUDO-CONTROL POINT TO WHICH THE PP IS ASSIGNED, SET THE
*         REISSUE FUNCTION AND ALLOW STORAGE MOVE FLAGS IN THE OUTPUT
*         REGISTER.  NOTE THAT ANY MONITOR FUNCTION WHOSE PROCESSOR MAY
*         CALL THE ROUTINE IS NOW STORAGE MOVABLE WHILE THE REQUEST IS
*         PENDING.  FUTURE CODE IN PP ROUTINES SHOULD CONSIDER ANY
*         MONITOR FUNCTION AS MOVABLE, ALLOWING FOR THE FOR THE TIME
*         THAT THIS IS ACTUALLY ACHIEVED.
*
*         ENTRY  (B5) = EXIT ADDRESS.
*                (A5) = *OR* ADDRESS.
*
*         USES   X - 4, 5, 7.
*                A - 4, 5, 7.
 
 
 REJ      TX4    A5-1,-FP
          LX4    PPXES-PPCES
          TA4    X4+ACPP,FPX GET CP/PCP ASSIGNMENT
          MX7    1
          BX5    X4
          SA4    CMCL        GET MOVE CONTROL
          BX4    X4-X5
          AX4    48
          SA5    A5+         GET OUTPUT REGISTER
          NZ     X4,REJ1     IF NO MOVE REQUEST FOR CP/PCP
          SX4    1           SET STORAGE MOVABLE FUNCTION FLAG
          LX4    56-0
          BX7    X4+X7
 REJ1     BX7    X7+X5       SET REJECTION BIT
          SA7    A5          STORE OR
          JP     B5          RETURN
          TITLE  MONITOR REQUEST PROCESSORS.
 MNR      SPACE  4
**        MNR - MONITOR REQUEST PROCESSOR.
*
*         ENTRY  (X7) = 0.
*                (B4) = REQUEST NUMBER.
*
*         EXIT   (X7) = 0.
*                (B2) = 2.
*                (B4) = REQUEST NUMBER.
 
 
 MNR      SA3    TMNR+B4     SET PROCESSOR
          SB2    B1+B1
          SB6    X3          PROCESS REQUEST
          TJP    (/PROBE/MNR,PROBE,B6)  PROCESS REQUEST
 IDL      SPACE  4
**        IDL - IDLE PROGRAM.
 
 
 
 IDL      CON    0           (RA) FOR IDLE PROGRAM
          CON    0           (RA+1) FOR IDLE PROGRAM
          CX2    X1          DELAY (6 BITS)
          CX2    X1          DELAY (6 BITS)
          EQ     2           LOOP
 MST      SPACE  4
**        MST - MOVE STORAGE.
*         MOVE A CONTROL POINT UP OR DOWN.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 3, 4, 5.
*                A - 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  SMP.
 
 
          MNR    MSTF,(/PROGRAM/MSE,ECM,/PROGRAM/MST)
 
 MST      SA5    A5          GET MOVE INCREMENT
          MX1    -12
          SA2    B7+FLSW
          BX4    -X1*X2
          LX5    6
          LX2    -RSHF
          LX4    6           FL
          SB6    MST2        RETURN ADDRESS
          MX3    -RMSK
          BX3    -X3*X2      RA
          LX2    12+12
          LX3    6           RA
          BX2    -X1*X2
          BX1    -X5         MOVE INCREMENT
          LX2    6           NFL
          IX0    X3-X2       SUBTRACT NFL SIZE FROM RA
          IX4    X4+X2       ADD NFL SIZE TO FL
          SB4    X4
          TJP    (/CME/SMI,CME,/PROGRAM/SMC,CMU,/PROGRAM/SMR)
 
*         INDICATE MOVE COMPLETE.
 
 MST2     TNO    /MCE/MST,MCE  IF MEMORY CLEARING ENABLED
          TA1    CMMS,SDA    COUNT STORAGE MOVE
 MST3     SX2    B1
          IX6    X1+X2
          SA6    A1
          SA5    A5          GET MOVE INCREMENT
          SA2    B7+FLSW     READ FL CONTROL WORD
          MX6    -RMSK
          SA1    B7+B1       READ EXCHANGE PACKAGE
          LX2    -RSHF       POSITION TO RA
          IX7    X2+X5       UPDATE RA
          BX6    -X6*X7      NEW RA
          LX7    RSHF        RE-POSITION
          SA7    A2+0
          LX6    36+6        POSITION NEW RA
          MX7    24
          BX1    -X7*X1      CLEAR OLD RA
          BX6    X6+X1       INSERT NEW RA
          SA6    A1          UPDATE EXCHANGE PACKAGE
          SA1    A2+B1       CHANGE SECOND FLSW WORD
          LX5    24
          IX7    X1+X5
          SA7    A1+
*         EQ     SMPX        EXIT
 SMP      SPACE  4,10
**        SMP - STORAGE MOVE PROGRAM MODE EXIT.
*
*         ENTRY  (A5) = ADDRESS OF *SMRL*.
*
*         EXIT   TO REQUEST PROCESSOR.
 
 
 SMPX     SX7    B0+
          SA7    SMPR        CLEAR REQUEST
          XJ
 
 SMP      SA1    SMPR        CHECK FOR REQUEST
          SB4    X1-1
          SA3    TMNR-1+X1   GET PROCESSOR ADDRESS
          SB6    X3+
          TJP    (/PROBE/MNR,PROBE,B6)
 SMPXP    SPACE  4,10
**        SMPXP - STORAGE MOVE EXCHANGE PACKAGE.
*
*         THIS EXCHANGE PACKAGE IS USED FOR CM AND UEM STORAGE
*         MOVES.  IT RUNS SEPARATE FROM THE SYSTEM CONTROL POINT
*         AT AN EQUAL PRIORITY, BUT ITS CPU RESOURCES ARE ACCOUNTED
*         TO THE SYSTEM CP.  UNLIKE THE SYSTEM CP, IT IS NOT FORCED
*         INTO CPU-0, UNLESS ECS IS USED FOR THE CM STORAGE MOVE.
*         THE PRIMARY PURPOSE OF THIS SEPARATE EXCHANGE PACKAGE IS
*         TO ALLOW IT TO TAKE ADVANTAGE OF THE ARCHITECHURE OF THE
*         MAINFRAMES EQUIPPED WITH *CME* (CENTRAL MEMORY EXTENSION).
 
 
 SMPXP    EXP    P=/PROGRAM/SMP,FL=(,MCM),FLX=(,MXM),B1=1,A5=SMIN,MA=SMP
,XP,EM=(,EXPFEC),EA=SMPXP
 
*         STSW.
 
          VFD    3/ZCPS      CPU STATUS
          VFD    57/0
 
*         CWQW.
 
          VFD    2/1
          VFD    7/MPRS      CPU PRIORITY
          VFD    1/0
          VFD    1/0         CPU SLICE ACTIVE
          VFD    1/0         RECALL FLAG
          VFD    1/1         EXTENDED CPU SLICE INCOMPLETE
          VFD    2/0
          VFD    9/0         SERVICE CYCLE
          VFD    9/SSSC*JCBE  SERVICE PARAMETERS INDEX
          VFD    1/0         *MTR* BYPASS FLAG
          VFD    2/0         NO CPU SELECTION
          VFD    3/0
          VFD    3/SMXT      STORAGE MOVE EXCHANGE PACKAGE TYPE
          VFD    18/0        *WQ* LINKAGE
 
*         CSAW.
 
          VFD    60/0
 
*         *CTMW*.
 
          VFD    60/0
 
          QUAL
 SMPXP    EQU    /PROGRAM/SMPXP
          QUAL   *
 PMR      SPACE  4
**        PMR - PROCESS INTER-MAINFRAME FUNCTION REQUEST.
*
*         ENTRY  NONE.
*
*         EXIT   NONE.
 
 
          MNR    PMRF,(/PROGRAM/PMR,MMF,/PROGRAM/HNG)
 MEC      SPACE  4,10
**        MEC - MOVE ECS STORAGE.
*
*         ENTRY
*T SM     12/ INC,30/,18/ CP
*         INC = INCREMENT.
*         CP  = CONTROL POINT ADDRESS.
*
*         EXIT
*T SM     60/0
 
 
          MNR    MECF,(/PROGRAM/MEC,UEC,/PROGRAM/HNG)
          SPACE  4
*         MONITOR/PROGRAM MODE EQUIVALENCES.
 
 
 PX       EQU    /MONITOR/PX
 PR       EQU    /MONITOR/PR
 SMPR     EQU    /MONITOR/SMPR
 SMIN     EQU    /MONITOR/SMIN
 PPRX     EQU    /MONITOR/PPRX
 
          QUAL   MONITOR
 CSM      EQU    /PROGRAM/CSM
 CSM1     EQU    /PROGRAM/CSM1
 REJ      EQU    /PROGRAM/REJ
          TTL    CPUMTR - CPU MONITOR.
          TITLE  CPUMTR BLOCK ORGANIZATION.
 BLOCKS   SPACE  4,10
**        CPUMTR COMMON BLOCK ORGANIZATION.
*
*             CPUMTR IS ORGANIZED TO PLACE OPTIONAL CODE INTO COMMON
*         BLOCKS WHICH CAN BE LOADED OR IGNORED AT DEAD START TIME,
*         DEPENDING UPON WHICH FEATURES ARE TO BE USED BY THE OPERATING
*         SYSTEM. WITH THE BLOCK ORGANIZTION A SITE OR MACHINE NOT
*         USING AN OPTIONAL FEATURE SUCH AS ECS OR MULTI-MAINFRAME
*         DOES NOT HAVE TO LOAD THIS CODE INTO CMR WITH CPUMTR.
*             A START OF BLOCK MACRO *BLOCK* AND AN END OF BLOCK MACRO
*         *ENDBLK* ARE USED TO DEFINE A CPUMTR COMMON BLOCK. THESE
*         MACROS PROVIDE THE LOADER AND QUAL BLOCK DEFINITIONS FOR
*         THE CPUMTR BLOCK. EACH BLOCK WILL NORMALLY BE QUALIFIED WITH
*         ITS NAME TO ASSURE PROGRAMMER AWARENESS OF WHICH ROUTINES
*         AND DATA CELLS RESIDE IN WHICH BLOCK.
*             A NULL BLOCK WILL USUALLY BE ASSOCIATED WITH EACH
*         OPTIONAL BLOCK AND WILL BE LOADED WHEN THE OPTIONAL BLOCK
*         IS NOT.
*             WHEN THERE ARE TWO ASSOCIATED BLOCKS, THE CPUMTR LOADER
*         WILL MAKE A DECISION AT DEADSTART TIME AS TO WHICH BLOCK TO
*         LOAD. FOR EXAMPLE IN THE CASE OF ECS TRANSEFER CODE, THE
*         LOADER WOULD CHECK THE ECS FIELD LENGTH TO DETERMINE THE
*         PRESENCE OF ECS.  IF THERE IS NO ECS FIELD LENGTH THE NULL
*         ECS TRANSFER BLOCK WOULD BE LOADED.
          BLOCK  CMU,(MOVE STORAGE WITH CMU.),PROGRAM
 SMP      SPACE  4
**        NOTE -
*         THE *CMU* MUST NOT BE USED IN MONITOR MODE ON A DUAL-CPU
*         MAINFRAME WITH ONLY ONE *CMU*, BECAUSE IT MAY BE IN USE BY
*         THE OTHER CPU, CAUSING MONITOR MODE TO WAIT FOR IT TO FINISH.
 CSC      SPACE  4,10
**        CSC - CLEAR STORAGE USING *CMU*.
*
*         ENTRY  (A5) = OUTPUT REGISTER ADDRESS.
*                (X5) = OUTPUT REGISTER.
*                (X1) = FUNCTION PARAMETERS FROM OUTPUT REGISTER.
*                (X7) = 0.
*
*         EXIT   ((A5)) = 0.
*
*         CALLS  CEC, CMP1, HNG, PRG.
*
*         USES   X - ALL.
*                A - 3, 4, 7.
*                B - 2, 3, 4, 5, 6.
 
 
 MVED     EQU    5           MOVE DIFFERENTIAL FOR OVERLAPPING CLEAR
 
*         *CMP* RETURN PROCESSING.
 
 CSC3     SX7    B0+
          TNZ    B3,(/MCE/CSTX,MCE,/PROGRAM/PRG1)  IF NOT LIST
 CSC4     SA3    A3+B1       READ NEXT LIST ENTRY
          SB5    -MVED       RESET (B5)
          SB2    B7-B5       SET SIZE OF INITIAL CLEAR
          NZ     X3,CSC1     IF NOT END OF LIST
          TEQ    (/MCE/CSTX,MCE,/PROGRAM/PRG1)  EXIT
 
*         ENTRY.
 
 CSC      LX5    -24
          SB3    X5          (B3) = 0 IF LIST PRESENT
          SB5    -MVED       SET MOVE DIFFERENTIAL
          BX3    X1
          LX5    59-43+24
          SB7    -B1
          MX2    -4
          TNG    X5,(/PROGRAM/CEC,UEC,/PROGRAM/HNG)  IF CLEARING ECS
          SB6    CSC3        *CMP* RETURN ADDRESS
          SB2    B7-B5       SET SIZE OF INITIAL CLEAR
          NZ     B3,CSC1     IF NOT LIST
          SA3    A5+B1       READ FIRST LIST WORD
 CSC1     BX6    X3
          AX3    24
          ZR     X3,CSC4     IF NOTHING TO CLEAR
          BX4    X2*X3
          NZ     X4,CSC2     IF MORE THAN 15 WORDS TO CLEAR
          SB2    X3+B7
 CSC2     SA7    X6+B2       CLEAR PRIMER AREA OR SHORT BLOCK
          SB2    B2-B1
          PL     B2,CSC2     IF MORE TO CLEAR
          ZR     X4,CSC4     IF SHORT BLOCK
          SB4    X3+B5       SET WORD COUNT
          MX0    -24
          SA4    CMPB        ADDRESS INCREMENT
          SX1    -MVED       MOVE DIFFERENTIAL
          SB5    CSCA        MOVE DESCRIPTOR WORD
          BX6    -X0*X6      FWA
          SB2    X4          100B
          EQ     CMP1        ENTER MOVE LOOP
 
 
 CSCA     CON    0           MOVE DESCRIPTOR WORD
 CMP      SPACE  4
**        CMP - CMU MOVE LOOP FOR USE IN PROGRAM MODE.
*         CMP PROCESSES BOTH UPWARD AND DOWNWARD MOVES WITH NO CHECK
*         FOR OVERLAP.  IF AN OVERLAP MAY EXIST AND IS NOT DESIRED
*         *SMC* MUST BE CALLED TO PREVENT AN OVERLAPING MOVE.
*
*         ENTRY  (X0) = ADDRESS TO MOVE FROM.
*                (B4) = WORD COUNT OF MOVE.
*                (X1) = (X0) - ADDRESS TO MOVE TO.
*                (B6) = EXIT ADDRESS.
*
*         IF ENTERED AT *CMP1* -
*                (X4) = ADDRESS INCREMENT (CMPB).
*                (X6) = ADDRESS TO MOVE FROM.
*                (X1) = (X6) - ADDRESS TO MOVE TO.
*                (A4) = CMPB.
*                (B2) = 100B.
*                (B6) = RETURN ADDRESS.
*
*         USES   X - 0, 1, 4, 6, 7.
*                B - 2, 4, 5.
*                A - 1, 4, 7.
*
*         PRESERVES  B3.
 
 
 CMP      SA4    CMPB        READ ADDRESS INCREMENT
          BX6    X0          SET ADDRESS FOR START OF MOVE
          SB2    X4+         100B
          SB5    CMPA        MOVE DESCRIPTOR WORD
 
*         ENTERED HERE FROM *SMC*.
 
 CMP1     MX7    -18         SET ADDRESSES
          BX0    -X1
          IX0    X6+X0
          BX6    -X7*X6
          LX6    30
          BX0    -X7*X0
          BX6    X6+X0
          SA1    A4+B1
 
*         CMU MOVE LOOP.
 
 CMP2     GE     B4,B2,CMP3  IF .GE. 100B WORDS TO MOVE
          SX1    B4          SET CHARACTER COUNT FOR SHORT BLOCK
          SX0    B4+B4
          LX1    3
          MX7    -4
          IX1    X1+X0
          BX0    -X7*X1      LL
          BX1    X7*X1       LU
          LX0    30-4
          LX1    48-4
          BX1    X1+X0
 CMP3     BX7    X6+X1       MERGE ADDRESSES AND CHARACTER COUNT
          IX6    X6+X4       INCREMENT ADDRESSES
          SA7    B5          STORE DESCRIPTOR WORD
          SB4    B4-B2       DECREMENT WORD COUNT
          IM     B5          MOVE STORAGE
          GT     B4,B0,CMP2  IF MORE WORDS TO TRANSFER
          JP     B6          RETURN
 
*         THE FOLLOWING WORDS MUST REMAIN IN ORDER.
 
 CMPA     CON    0           INDIRECT MOVE DESCRIPTOR WORD
 CMPB     VFD    30/100B,30/100B  ADDRESS INCREMENT
          VFD    12/100B*10/20B,48/0  CHARACTER COUNT FOR 100B WORDS
 SMC      SPACE  4
**        SMC - STORAGE MOVE WITH CMU.
*         SMC MOVES BLOCKS OF 100B WORDS UPWARD OR DOWNWARD
*         PREVENTING OVERLAP.
*
*         ENTRY  (X0) = ADDRESS TO MOVE FROM.
*                (B4) = WORD COUNT OF MOVE.
*                (X1) = (X0) - ADDRESS TO MOVE TO.
*                (B6) = EXIT ADDRESS.
*
*         USES   X - 0, 1, 4, 6, 7.
*                B - 2, 4, 5, 6.
*                A - 1, 4, 7.
*
*         CALLS  CMP1.
 
 
 SMC      SA4    CMPB        ADDRESS INCREMENT
          SB5    SMCA        MOVE DESCRIPTOR WORD
          BX6    X0
          SB2    X4          100B
          PL     X1,CMP1     IF DOWNWARD MOVE - NO OVERLAP
          SX6    X4
          BX4    -X4         COMPLEMENT INCREMENT
          IX6    X0-X6       START MOVE FROM END OF BLOCK
          SX0    B4          WORD COUNT
          IX6    X0+X6
          EQ     CMP1        ENTER MOVE LOOP
 
 
 SMCA     CON    0           MOVE DESCRIPTOR WORD
 
          ENDBLK
          BLOCK  0CMU,(MOVE STORAGE WITH REGISTERS.),PROGRAM
 SMR      SPACE  4
**        SMR - STORAGE MOVE VIA REGISTERS.
*         SMR MOVES BLOCKS OF 10B WORDS THROUGH A REGISTER MOVE
*         LOOP.  BLOCKS WHICH ARE NOT MULTIPLES OF 10B WORDS
*         SHOULD BE MOVED WITH *MSR*.
*
*         ENTRY  (X0) = ADDRESS TO MOVE FROM.
*                (B4) = WORD COUNT OF MOVE.
*                (X1) = (X0) - ADDRESS TO MOVE TO.
*                (B6) = EXIT ADDRESS.
*
*         USES   X - ALL.
*                B - 2, 4, 5, 6.
*                A - 1, 2, 3, 4, 6, 7.
 
 
 SMR      SB5    X1+         B5 = MOVE DIFFERENCE
          SA1    X0+         A1 = FWA TO MOVE FROM
          SX0    B4-B1       (X0) = WORD COUNT - 1
          SB2    B1          SET DIRECTION OF MOVE
          PL     B5,SMR1     IF DOWNWARD MOVE
          SB4    B4-B1
          SA1    A1+B4
          SB2    -1
 SMR1     SX5    -B1
          AX0    3           (X0) = WORD COUNT - 10B
          SA2    A1+B2
          SB2    B2+B2
 
*         REGISTER MOVE LOOP.
 
 SMR2     SA3    A1+B2       READ NEXT TWO WORDS
          BX6    X1
          SA4    A2+B2
          LX7    X2
          SA6    A1-B5       STORE TWO WORDS
          IX0    X0+X5       DECREMENT BLOCK COUNT
          SA7    A2-B5
          SA1    A3+B2       READ NEXT TWO WORDS
          SA2    A4+B2
          BX6    X3
          LX7    X4
          SA6    A3-B5       STORE TWO WORDS
          SA7    A4-B5
          SA3    A1+B2       READ NEXT TWO WORDS
          SA4    A2+B2
          BX6    X1
          LX7    X2
          SA6    A1-B5       STORE TWO WORDS
          SA7    A2-B5
          SA1    A3+B2       READ NEXT TWO WORDS
          SA2    A4+B2
          BX6    X3
          LX7    X4
          SA6    A3-B5       STORE LAST TWO WORDS
          SA7    A4-B5
          NZ     X0,SMR2     IF NOT END OF MOVE
          SX0    B1+B1
 SMR3     BX6    X1          MOVE THE LAST 10B WORDS
          LX7    X2
          SA6    A1-B5
          SA7    A2-B5
          NG     X0,SMR4     IF END OF MOVE
          SA1    A1+B2       READ THE NEXT TWO WORDS
          SA2    A2+B2
          IX0    X0+X5       DECREMENT THE LOOP COUNT
          EQ     SMR3        LOOP TO STORE THE NEXT TWO WORDS
 
 SMR4     JP     B6          RETURN
 CSP      SPACE  4,10
**        CSP - CLEAR STORAGE THROUGH THE CPU.
*
*         ENTRY  (A5) = PPU OUTPUT REGISTER ADDRESS.
*
*         USES   X - 0, 1, 5, 6.
*                B - 3, 4, 5, 6.
*                A - 1, 6, 7.
 
 
 CSP      LX5    -24
          SB3    X5          (B3) = 0 IF LIST PRESENT
          BX6    X6-X6
          LX5    59-43+24
          TNG    X5,(/PROGRAM/CEC,UEC,/PROGRAM/HNG)  IF CLEARING ECS
          SB4    12B
          SB6    B1+B1
          NZ     B3,CSP1     IF NOT LIST OPTION
          SA1    A5+B1       GET LIST ENTRY
 CSP1     BX5    X1
          AX1    24          EXTRACT WORD COUNT
          ZR     X1,CSP4     IF NOTHING TO CLEAR
          SB5    X1-1        WORDS TO CLEAR
          LT     B5,B4,CSP3  IF LESS THAN 13 WORDS
          SA7    X5+B5
          SB4    B4-B6
          SA6    A7-B1
          SB5    B5-B6       WORDS TO CLEAR
 CSP2     SA7    A7-B6       CLEAR 10 WORD BLOCKS
          SA6    A6-B6
          SA7    A7-B6
          SA6    A6-B6
          SA7    A7-B6
          SB5    B5-B4       DECREMENT WORD COUNT
          SA6    A6-B6
          SA7    A7-B6
          SA6    A6-B6
          GT     B5,B4,CSP2  IF STILL 11 OR MORE WORDS TO CLEAR
 CSP3     SA6    X5+B5
          SB5    B5-B1
          PL     B5,CSP3     IF STILL MORE TO CLEAR
          TNZ    B3,(/MCE/CSTX,MCE,/PROGRAM/PRG1)  IF NOT LIST
          SB4    12B
 CSP4     SA1    A1+1
          NZ     X1,CSP1     IF NOT END OF LIST
          TEQ    (/MCE/CSTX,MCE,/PROGRAM/PRG1)  EXIT
 
          ENDBLK
          BLOCK  CME,(CENTRAL MEMORY EXTENSION.)
          SPACE  4,10
 HNG      EQU    /MONITOR/HNG
 MT       EQU    /MONITOR/MT
 PPR1     EQU    /MONITOR/PPR1
 T1       EQU    /MONITOR/T1
 T2       EQU    /MONITOR/T2
 T3       EQU    /MONITOR/T3
 RA       EQU    /MONITOR/RA
 RA1      EQU    /MONITOR/RA1
 RB6      EQU    /MONITOR/RB6
          SPACE  4,10
*         DEFINE CME INSTRUCTION BLOCK.
 
 
 CME$     EQU    1
 CCP      SPACE  4,10
**        CCP - *CCP* EXTENSION FOR *CME* MACHINE.
*
*         ENTRY  (B3) = RETURN ADDRESS.
*                (X1) = *JCB* *CSJT* WORD.
*                (A1) = ADDRESS OF *JCB* *CSJT* WORD.
*
*         EXIT   CONVERTED SCHEDULING PARAMETERS SET IN *JCB* ENTRY.
*
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 3, 6.
*                B - 4.
 
 
 CCP      BSS    0           ENTRY
          SA3    CCPA        =15.625
          BX7    -X0*X1      UNEXTENDED CPU SLICE
          LX1    -12
          BX6    -X0*X1      RECALL CPU SLICE
          IX7    X7-X6       UNEXTENDED SLICE - RECALL SLICE
          PX6    X6
          NX6    X6
          FX6    X6*X3
          UX6,B4 X6
          LX6    B4          CONVERTED RECALL CPU SLICE
          LX1    -12
          BX2    -X0*X1      CPU SLICE EXTENSION
          IX7    X7+X2       UNEXTENDED SLICE + EXTENSION - RECALL SLICE
          PX2    X2
          NX2    X2
          FX2    X2*X3
          UX2,B4 X2
          LX2    B4          CONVERTED CPU SLICE EXTENSION
          LX6    -18
          BX6    X6+X2
          PX7    X7
          NX7    X7
          FX7    X7*X3
          UX7,B4 X7
          LX7    B4          CONVERTED (*US* + *SE* - *RS*)
          LX6    36
          BX6    X6+X7
          SA6    A1+B1
          ERRNZ  CSAT-CSJT-1 WORDS MUST BE CONTIGUOUS
          LX1    -12
          BX6    -X0*X1      SYSTEM I/O CPU THRESHOLD
          PX6    X6
          NX6    X6
          FX6    X6*X3
          UX6,B4 X6
          LX6    B4          CONVERTED SYSTEM I/O CPU THRESHOLD
          SA1    A6+B1
          ERRNZ  CSBT-CSAT-1 WORDS MUST BE CONTIGOUS
          MX0    42
          BX1    X0*X1
          BX6    X1+X6
          SA6    A1
          JP     B3          RETURN
 
 
 CCPA     CON    15.625
 CPT      SPACE  4,15
**        CPT - EXTENSION FOR CYBER 180.
*
*         ENTRY  (B3) = EXIT ADDRESS.
*                (B6) = 200B IF ENTERED AT *CPT1* (*BNJ* CALL).
*
*         EXIT   TO  /MONITOR/CPT1.
*                (X0) = CPU TIME INCREMENT IN MACHINE UNITS.
*                (MT+A0) = 0 IF RA+1 PROCESS AND NOT CPU SWITCH.
*                (MT+A0) = -ACAD2 IF NOT RA+1 PROCESS OR IF CPU SWICH.
*                (CL+CPBT+A0) RESET TO CURRENT CLOCK.
*                (CL+CMST+A0) UPDATED.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 4, 6.
 
 
 CPT      BSS    0           ENTRY
          SB6    B0+         DO NOT SET CPU SWITCH FLAG
 
*         ENTRY FROM /MONITOR/*BNJ*.
 
 CPT1     SA1    CL+CMST+A0  GET MONITOR MODE PARAMETERS
          SA2    CL+CPBT+A0  GET PROGRAM MODE BASE TIME
          SA3    MT+A0       GET MONITOR MODE ACCUMULATED TIME
          RC     X6          READ CLOCK
          UX1,B4 X1
          SB6    B4+B6       SET CPU SWITCH STATUS
          PX7    B6,X6       SET FUNCTION WITH STATUS AND NEW BASE TIME
          SA6    A2          UPDATE PROGRAM MODE BASE TIME
          SA7    A1          UPDATE MONITOR MODE PARAMETERS
          SX7    B0+         SET TO CLEAR MONITOR MODE ACCUMULATOR
          ZR     B6,CPT3     IF RA+1 PROCESS AND NOT CPU SWITCH
          ERRNZ  CCPF        CODE DEPENDS ON VALUE
          TX7    -ACAD2      - (EXCHANGE JUMP TIME)
          ZR     B4,CPT3     IF RA+1 PROCESS
 
*         COMPUTE MONITOR MODE TIME SINCE LAST BASE TIME.
*
*         THE MICROSECOND CLOCK ON THE CYBER 170-865 AND 170-875 WILL
*         WRAP APPROXIMATELY EVERY 1.2 HOURS, SINCE IT IS ONLY 32 BITS
*         WIDE.  ALL OTHER MODELS IN THE 170-800 SERIES HAVE 48 BIT
*         COUNTERS, WHICH WILL WRAP ONLY ONCE EVERY 9 YEARS OR SO.
*         SINCE THIS COUNTER IS RESET AT DEADSTART, IT IS SAFE TO
*         ASSUME THAT IF A WRAP IS DETECTED, THE COUNTER IS ONLY 32
*         BITS WIDE.
 
          IX5    X6-X1       TIME SINCE MONITOR MODE BASE TIME
          PL     X3,CPT2     IF *MT* NOT PREVIOUSLY ADJUSTED BY *CPT*
          SX3    B0
 CPT2     IX3    X3+X5       ADD CURRENT AND ACCUMULATED TIME
          IX3    X3-X7       ADD EXCHANGE JUMP TIME
          PL     X5,CPT3     IF NO OVERFLOW OF COUNTER
          SX0    1
          LX0    32
          IX3    X3+X0
 
*         COMPUTE PROGRAM MODE CPU TIME USED.
*
*         IF MONITOR MODE WAS NOT ENTERED TO PROCESS AN RA+1 CALL OR IF
*         A CPU SWITCH IS PENDING, THE MONITOR MODE ACCUMULATOR FOR THE
*         CPU WILL BE RESET WITH A VALUE OF *-ACAD2*.  SINCE EXIT FROM
*         MONITOR MODE ADDS AN INCREMENT OF *ACAD* (TWICE THE VALUE OF
*         *ACAD2*) TO THE ACCUMULATOR, THE RESULT IN THIS CASE WILL BE
*         TO ACCOUNT ONLY FOR THE EXCHANGE JUMP BACK TO PROGRAM MODE.
*         *CPT* WILL ALREADY HAVE ACCOUNTED FOR THE EXCHANGE JUMP INTO
*         MONITOR MODE.
 
 CPT3     IX6    X6-X2       COMPUTE TIME USED
          SA7    MT+A0       RESET MONITOR MODE ACCUMULATOR
          IX0    X6-X3       DEDUCT MONITOR MODE TIME
          PL     X0,/MONITOR/CPT1  IF NO UNDERFLOW
          SX0    B0+
          EQ     /MONITOR/CPT1  ENTER MAIN *CPT* PROCESSOR
 CSM      SPACE  4,15
**        CSM - CLEAR STORAGE THROUGH CPU (MONITOR MODE).
*
*         ENTRY  (X1) = WORD COUNT.
*                (X2) = FWA.
*                (B3) = RETURN ADDRESS.
*
*         EXIT   (X7) = 0.
*
*         USES   X - ALL.
*
*         CALLS  /MONITOR/RB3.
 
 CSM      MX6    -3          INITIALIZE
          SX0    B1
          BX5    -X6*X1      REMAINDER
          BX7    X7-X7
          AX1    3           10B WORD BLOCK COUNT
          ZR     X1,CSM2     IF .LT. 10B
          IX3    X2+X0       FWA+1
          SX6    B0+
          SX4    2
 CSM1     EWX6   X2
          IX1    X1-X0       DECREMENT BLOCK COUNT
          NO
          EWX7   X3
          IX2    X2+X4
          IX3    X3+X4
          EWX6   X2
          EWX7   X3
          IX2    X2+X4
          IX3    X3+X4
          EWX6   X2
          EWX7   X3
          IX2    X2+X4
          IX3    X3+X4
          EWX6   X2
          EWX7   X3
          IX2    X2+X4
          IX3    X3+X4
          NZ     X1,CSM1     IF NOT COMPLETE
 CSM2     ZR     X5,/MONITOR/RB3  IF COMPLETE
          IX5    X5-X0
          EWX7   X2
          IX2    X2+X0
          EQ     CSM2        CLEAR REMAINDER
 MNR      SPACE  4,10
**        MNR - *CME* EXTENSION TO PROGRAM MODE EXIT PROCESSING.
 
 
 MNR      SA1    B2          EXCHANGE PACKAGE P-ADDRESS
          SA2    B0
          SA3    VFLR
          MX0    24
          BX4    X0*X1
          NZ     X2,MNR2     IF WORD ZERO IS NON-ZERO
          BX6    X3
          ZR     X4,MNR2     IF P-ADDRESS IS ZERO
          AX6    18
          SX7    B0+         CLEAR RESPONSE
          NZ     X6,/MONITOR/MTRX  IF REQUEST NOT COMPLETE
 MNR1     SA7    X3          SET RESPONSE
          SA6    A3          CLEAR REQUEST WORD
          SA1    VFLXP+STSW  SET NULL STATUS
          MX0    -57
          BX7    -X0*X1
          SA7    A1+
          EQ     /MONITOR/BNJ1  BEGIN NEW JOB
 
 MNR2     SX6    VFL         RESET P-ADDRESS
          SX7    B1          SET RESPONSE
          BX1    -X0*X1      CLEAR P-ADDRESS
          LX6    36
          LX7    36
          BX6    X6+X1
          SA6    A1
          BX6    X6-X6       CLEAR REQUEST WORD
          EQ     MNR1        EXIT
 MSR      SPACE  4,15
**        MSR - MONITOR MODE STORAGE MOVE THROUGH REGISTERS
*               FOR *CME* MAINFRAMES.
*
*         ENTRY  (X0) = ADDRESS TO MOVE FROM.
*                (X1) = (X0) - ADDRESS TO MOVE TO.
*                (B4) = WORD COUNT.
*                (B6) = RETURN ADDRESS.
*
*         CALLS  PSM.
*
*         USES   X - 0, 1, 4, 6, 7.
*                B - 4, 5.
 
 
 MSR      SB5    MSR1        *PSM* RETURN ADDRESS
          EQ     PSM         PRESET STORAGE MOVE
 
*         (X0) = ADDRESS TO MOVE FROM.
*         (X1) = ADDRESS TO MOVE TO.
*         (X4) = INCREMENT (1 OR -1).
*         (B4) = BLOCK COUNT (WORD COUNT / 10B).
*         (B6) = RETURN ADDRESS.
 
 MSR1     ERX6   X0          LOAD UP FIRST DATA
          IX0    X0+X4
          ERX7   X0
          IX0    X0+X4
          SB4    B4-1        DECREMENT BLOCK COUNT
          EWX6   X1
          IX1    X1+X4
          ERX6   X0
          IX0    X0+X4
          EWX7   X1
          IX1    X1+X4
          ERX7   X0
          IX0    X0+X4
          EWX6   X1
          IX1    X1+X4
          ERX6   X0
          IX0    X0+X4
          EWX7   X1
          IX1    X1+X4
          ERX7   X0
          IX0    X0+X4
          EWX6   X1
          IX1    X1+X4
          ERX6   X0
          IX0    X0+X4
          EWX7   X1
          IX1    X1+X4
          ERX7   X0
          IX0    X0+X4
          EWX6   X1
          IX1    X1+X4
          EWX7   X1
          IX1    X1+X4
          GT     B4,B0,MSR1  IF MORE BLOCKS TO MOVE
          JP     B6          RETURN
 PLF      SPACE  4,10
**        PLF - PROCESS LOCAL FNT.
 
 
 PLF      SA3    B7+FLSW     GET RA AND NFL
          MX0    -12
          BX1    -X0*X5      EXTRACT NFL ADDRESS/PARAMETER
          LX5    24
          MX0    -3
          BX2    -X0*X5      EXTRACT SUBFUNCTION
          AX3    RSHF
          LX5    59-41-24
          MX0    -RMSK
          BX4    -X0*X3
          AX3    48-RSHF
          LX4    6           RA
          MX0    -18
          ZR     X3,HNG      IF NO NFL
          BX6    X4
          LX3    6           NFL
          SA6    RA
          SB6    X2-TPLFL-1
          PL     B6,HNG      IF ILLEGAL SUBFUNCTION
          JP     TPLF+TPLFL+1+B6  JUMP TO PROCESSOR
 
*         EXIT TO PROCESSOR WITH -
*
*         (X0) = 42/-0,18/0.
*         (X1) = NFL ADDRESS/PARAMETER.
*         (X3) = NFL SIZE.
*         (X4) = RA.
*         (X5) = *CREATE SPECIAL FILE* FLAG IN LEFT-MOST BIT.
*         (X7) = 0.
*         (RA) = RA.
 
 TPLF     BSS    0
          LOC    0
 
+         IX2    X3-X1
          EQ     PLF14       (DLFS) - DELETE ENTRY
 
+         IX2    X3-X1
          SX7    B1
          EQ     PLF14       (DLCS) - RETURN FILE COUNT
 
*         EQ     PLF1        (CRFS) - CREATE LOCAL FNT ENTRY
 
 TPLFL    BSS    0
          LOC    *O
 
*         SET UP FOR FNT SEARCH.
 
 PLF1     SA7    T2          CLEAR EMPTY ENTRY POINTER
          SX2    X3-FNTN     COMPUTE ADDRESS OF LAST ENTRY
          SX6    LENF
          PX2    X2
          PX3    X6
          NX3    X3
          FX1    X2/X3
          UX1    B6,X1
          LX1    X1,B6
          IX3    X6*X1
          SA1    A5+B1
          SX2    FNTN        ALLOW USE OF SPECIAL FILE RESERVED ENTRY
          NG     X5,PLF2     IF SPECIAL FILE
          SX2    X2+SRFE*LENF  PREVENT USE OF RESERVED ENTRIES
 PLF2     IX6    X4-X2
          SA6    A7+B1       SAVE FWA OF LAST RESERVED ENTRY
          SX3    X3+FNTN
          IX7    X4-X3       ADDRESS OF LAST ENTRY
          BX5    X0*X1       FILE NAME
          SA7    A7-B1
          EWX5   X7          SAVE FILE NAME MATCH
          SX1    FNTN-LENF*2
          SX2    FNTN-LENF
          IX6    X4-X1
          IX7    X4-X2
 
*         SEARCH FOR MATCHING ENTRY.
 
 PLF4     SX3    LENF*2      SEARCH INCREMENT
          IX6    X6-X3
          IX7    X7-X3
          ERX1   X6
          ERX2   X7
          BX3    X1-X5
          BX4    X2-X5
          BX3    X0*X3
          BX4    X0*X4
          ZR     X3,PLF7     IF FOUND
          ZR     X4,PLF6     IF FOUND
          ZR     X1,PLF8     IF EMPTY
 PLF4.1   NZ     X2,PLF4     IF NOT EMPTY
          SA1    A6
          IX1    X7-X1
          PL     X1,PLF4     IF USE OF RESERVED ENTRY NOT ALLOWED
          SA7    T2          SAVE ADDRESS OF EMPTY ENTRY
 PLF4.9   SX3    LENF*2
 
*         SEARCH FOR MATCH (EMPTY ENTRY FOUND).
 
 PLF5     IX6    X6-X3
          IX7    X7-X3
          ERX1   X6
          ERX2   X7
          BX1    X1-X5
          BX2    X2-X5
          BX1    X0*X1
          BX2    X0*X2
          ZR     X1,PLF7     IF FOUND
          NZ     X2,PLF5     IF NOT FOUND
 PLF6     BX6    X7
 PLF7     SA4    T1
          SX7    B0+         CLEAR LAST ENTRY
          EWX7   X4
          BX2    X6-X4
          ZR     X2,PLF10    IF LAST ENTRY
          SA3    RA
          IX3    X3-X6
          LX3    36          BYTE 1 OF RESPONSE
          SX7    B1          STATUS = FILE ALREADY EXISTS
          BX7    X3+X7
          EQ     PPR1        EXIT
 
*         EMPTY ENTRY FOUND.
 
 PLF8     SA1    A6
          IX1    X6-X1
          PL     X1,PLF4.1   IF USE OF RESERVED ENTRY NOT ALLOWED
          SA6    T2          SAVE ADDRESS OF EMPTY ENTRY
          EQ     PLF4.9      CONTINUE SEARCH
 
*         NO MATCH FOUND, CREATE ENTRY.
 
 PLF10    SA4    T2          ADDRESS OF FIRST EMPTY ENTRY
          SA1    RA          UPDATE LOCAL FILE COUNT
          SX2    LFCN
          IX2    X1-X2
          ERX6   X2
          SX3    X6-MXLF+SRFE+2  CHECK MAXIMUM FILE COUNT
          ZR     X4,PLF11    IF NO FREE ENTRY
          SX7    FNTN+SRFE*LENF
          IX1    X1-X7
          IX1    X4-X1
          MX7    1
          BX7    X7*X1
          LX7    1
          IX6    X6+X7       INCREMENT FILE COUNT IF NOT SPECIAL FILE
          SX3    X6-MXLF+SRFE+1
          PL     X3,PLF11    IF FILE LIMIT EXCEEDED (MAXIMUM NFL)
          EWX6   X2
          SX7    LOFT*100B   SET LOCAL FILE TYPE
          BX7    X5+X7
          EWX7   X4
          R=     X5,FSTL
          SX7    4           FST COMPLETE/NOT BUSY
          IX6    X5+X4       ADDRESS OF FST
          EWX7   X6
          SA1    RA
          IX7    X1-X4       NFL ADDRESS
          LX7    36
          EQ     PPR1        EXIT WITH RESPONSE
 
 PLF11    SX7    B1+B1       STATUS = LOCAL FILE LIMIT
          PL     X3,PPR1     IF FILE LIMIT EXCEEDED (MAXIMUM NFL)
          LX7    1           STATUS = NEED MORE NFL
          EQ     PPR1        EXIT
 
*         DELETE FNT ENTRY.
 
 PLF14    NG     X2,HNG      IF NFL ADDRESS OUT OF RANGE
          IX2    X4-X1       ADDRESS OF FNT
          ERX3   X2          READ FNT
          SX6    X1-FNTN-SRFE*LENF-LENF
          R=     X1,FSTL
          IX5    X2+X1       ADDRESS OF FST
          ZR     X3,HNG      IF EMPTY
          MX3    1
          ERX0   X5          READ FST
          NZ     X7,PLF17    IF COUNTING FILES
          BX3    -X6*X3
          LX3    1
          BX6    X6-X6       CLEAR FNT/FST
          EWX6   X2
          EWX6   X5
          IX5    X5+X1
          ERRNZ  FSTL-1
          ERRNZ  LENF-3
          EWX6   X5
          SX6    LFCN        DECREMENT FILE COUNT IF NOT SPECIAL FILE
          IX6    X4-X6
          ERX2   X6
          IX1    X2-X3
          NG     X1,HNG      IF NEGATIVE FILE COUNT
          EWX1   X6          UPDATE *LFCN*
          SA2    B7+EOCW     CHECK EXECUTE-ONLY FILE
          SA5    A5
          MX1    12
          LX5    -12
          BX6    X5-X2
          BX6    X1*X6
          NZ     X6,PPR1     IF NO MATCH
          BX6    -X1*X2
          SA6    A2          CLEAR EXECUTE ONLY FILE POINTER
          EQ     PPR1        RETURN
 
*         COUNT FILES ON EQUIPMENT SPECIFIED IN FST.
 
 PLF17    SA2    B7+FLSW     FETCH NFL SIZE
          MX7    12
          BX2    X7*X2
          SX6    FNTN
          LX2    6+12        NFL
          IX2    X2-X6
          SX3    LENF        COMPUTE ADDRESS OF LAST FNT SLOT
          PX5    X3
          PX2    X2
          NX5    X5
          FX1    X2/X5
          UX1    B6,X1
          LX1    X1,B6
          IX6    X1*X3
          MX7    59          INITIALIZE FILE COUNT
          SX6    X6+FNTN-FSTL
          SA4    RA          FETCH REFERENCE ADDRESS
          SX5    B1
          IX6    X4-X6       ADDRESS OF LAST FST SLOT IN NFL
          SX1    FNTN-FSTL-LENF
          IX1    X4-X1       INITIALIZE NFL SCAN
          EWX0   X6
 PLF18    IX1    X1-X3
          ERX4   X1          READ FST ENTRY
          BX2    X4-X0
          AX2    48
          NZ     X2,PLF18    IF NOT MATCHING EST ORDINAL
          BX4    X1-X6
          IX7    X7+X5       INCREMENT FILE COUNT
          NZ     X4,PLF18    IF NOT END OF NFL
          LX7    12
          EWX4   X6          CLEAR SEARCH OBJECTIVE
          EQ     PPR1        EXIT
 PSM      SPACE  4,20
**        PSM - PRESET STORAGE MOVE.
*
*         ENTRY  (X0) = ADDRESS TO MOVE FROM.
*                (X1) = (X0) - ADDRESS TO MOVE TO.
*                (B4) = WORD COUNT.
*                (B5) = RETURN ADDRESS.
*                (B6) = RETURN ADDRESS FOR CALLING ROUTINE.
*
*         EXIT   (X0) = ADDRESS TO MOVE FROM.
*                (X1) = ADDRESS TO MOVE TO.
*                (X4) = INCREMENT (1 OR -1).
*                (B4) = BLOCK COUNT (WORD COUNT / 10B).
*                (B6) = RETURN ADDRESS FOR CALLING ROUTINE.
*
*         USES   X - 0, 1, 4, 6, 7.
*                B - 4.
*
*         CALLS  RB6.
*
*         THE ADDRESSES ARE ADJUSTED TO PREVENT OVERLAP, IF NECESSARY.
 
 
 PSM      SX4    B1+         INCREMENT
          SX7    B4          WORD COUNT
          MX6    -3
          BX6    -X6*X7      REMAINDER
          IX7    X0-X1       ADDRESS TO MOVE TO
          PL     X1,PSM1     IF DOWNWARD MOVE
          SX1    B4+         WORD COUNT
          IX0    X0+X1       FWA = LWA+1
          IX7    X7+X1
          IX0    X0-X4       FWA = LWA
          IX7    X7-X4
          BX6    -X6         COMPLEMENT REMAINDER
          BX4    -X4         COMPLEMENT INCREMENT
 PSM1     BX1    X7          FWA OF MOVE
          SX7    B4          WORD COUNT
          AX7    3           TRUNCATE WORD COUNT
          SB4    X7          BLOCK COUNT (WORD COUNT / 10B)
 PSM2     ZR     X6,PSM3     IF NO REMAINDER
          ERX7   X0          MOVE REMAINDER
          IX0    X0+X4
          EWX7   X1
          IX1    X1+X4
          IX6    X6-X4
          EQ     PSM2        LOOP FOR NEXT WORD
 
 PSM3     ZR     B4,RB6      IF MOVE COMPLETE
          JP     B5          RETURN
 RTC      SPACE  4,15
**        RTC - UPDATE REAL-TIME CLOCK FROM CPU MICROSECOND CLOCK.
*
*         READS THE CPU MICROSECOND CLOCK AND UPDATES THE REAL TIME
*         CLOCK (RTCL) WHEN PROCESSING *MTR* REQUESTS.
*
*         ENTRY  (X5) = CPU MICROSECOND CLOCK.
*
*         EXIT   (RTCL) = UPDATED TO NEAREST SECOND AND MILLISECOND.
*                (X5) = CPU MICROSECOND CLOCK AT ENTRY.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 4.
 
 
 RTC      SA2    RTCA        CPU CLOCK VALUE AT LAST WHOLE MILLISECOND
          SX3    B0+
          IX1    X5-X2       MICROSECONDS SINCE LAST WHOLE MILLISECOND
          PL     X1,RTC1     IF NO OVERFLOW
 
*         SINCE THE 48 BIT CPU CLOCK ON A CYBER 180 WILL OVERFLOW ONLY
*         AFTER APPROXIMATELY 9 YEARS, IT IS SAFE TO ASSUME THAT IF AN
*         OVERFLOW HAS OCCURRED IT IS ON A CYBER 170-865/875, WHICH
*         USES A 32 BIT CPU CLOCK WHICH OVERFLOWS EVERY 1.2 HOURS.
 
          SX3    B1+         CORRECT FOR OVERFLOW
          LX3    32
          IX1    X1+X3
 RTC1     SX6    1000        ONE MILLISECOND
          IX7    X1-X6
          PX1    X1
          NG     X7,/MONITOR/PMN1  IF .LT. ONE MILLISECOND
          BX7    X5
          SA7    RTCE        SAVE ENTRY CLOCK VALUE
          PX7    X6
          NX7    X7
          FX7    X1/X7       CALCULATE MILLISECONDS
          UX7    X7,B4
          LX7    B4          INTEGER MILLISECONDS
          IX6    X6*X7
          IX6    X2+X6       MICROSECONDS AT NEW WHOLE MILLISECOND
          BX6    -X3*X6      CLEAR POSSIBLE OVERFLOW (CYBER 865/875)
          SA6    A2
          MX2    24
          SA3    RTCC        *RTCL* AT LAST *CPUMTR* UPDATE
          BX1    -X2*X3      ISOLATE OLD *RTCL* COMPONENTS
          BX3    X2*X3
          IX7    X1+X7       CURRENT MILLISECONDS
          SA1    RTCB        MICROSECONDS AT LAST WHOLE SECOND
          LX3    24
          BX7    -X2*X7      NEW *RTCL* MILLISECOND COMPONENT
          BX2    X2-X2
          SX4    B1
          IX1    X5-X1       MICROSECONDS SINCE LAST WHOLE SECOND
          SB4    10-1
          PL     X1,RTC2     IF NO OVERFLOW
          SX2    B1          CORRECT FOR OVERFLOW
          LX2    32
          IX1    X1+X2
          IX5    X5+X2
 RTC2     SX6    1000000/100B
          LX6    6
          IX6    X1-X6
          NG     X6,RTC3     IF LESS THAN ONE SECOND
          NG     B4,RTC3     IF MORE THAN A 10 SECOND UPDATE
          BX1    X6
          SB4    B4-B1
          IX3    X3+X4       INCREMENT SECONDS
          NZ     X6,RTC2     IF NOT WHOLE SECONDS
 RTC3     IX6    X5-X1       MICROSECONDS AT NEW WHOLE SECOND
          MX1    -24
          BX6    -X2*X6      CLEAR POSSIBLE OVERFLOW (CYBER 865/875)
          SA6    A1
          BX3    -X1*X3      NEW *RTCL* SECONDS COMPONENT
          LX3    36
          BX7    X3+X7       UPDATE REAL TIME CLOCK
          SA7    A3+         SAVE NEW *RTCL* VALUE
          SA7    RTCL
          PL     B4,RTC4     IF NOT AN EXCESSIVE UPDATE
          SA1    RTCD        COPY OPERATOR MESSAGE
          BX6    X1
          SA1    A1+B1
          TA6    MS2W,SCA
          BX6    X1
          SA1    A1+B1
          SA6    A6+B1
          BX6    X1
          SA6    A6+B1
 RTC4     SA5    RTCE        RESTORE ENTRY CLOCK VALUE
          EQ     /MONITOR/PMN1  EXIT TO PROCESS *MTR* REQUEST
 
 
 RTCA     CON    0           MICROSECONDS AT LAST WHOLE MILLISECOND
 RTCB     CON    0           MICROSECONDS AT LAST WHOLE SECOND
 RTCC     CON    377777000000000000B  *RTCL* INITIAL AND PREVIOUS
 RTCD     DATA   C*CLOCK UPDATE WARNING.*
 RTCE     CON    0           CPU CLOCK AT ENTRY
 SMI      SPACE  4,15
**        SMI - PROGRAM MODE STORAGE MOVE USING
*               CM TO CM COPY INSTRUCTION.
*
*         ENTRY  (X0) = ADDRESS FROM MOVE TO.
*                (X1) = (X0) - ADDRESS TO MOVE TO.
*                (B4) = WORD COUNT OF MOVE.
*                (B6) = RETURN ADDRESS.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                B - 4, 5.
*
*         CALLS  RB6.
 
 
 SMI      SB5    400B        MAXIMUM WORD COUNT / TRANSFER
          SX7    B4+         WORD COUNT
          GE     B4,B5,SMI1  IF WORD COUNT .GE. TRANSFER SIZE
          SB5    B4+         SET TRANSFER SIZE TO WORD COUNT
 SMI1     SX4    B5          WORD COUNT / TRANSFER
          BX2    X0          PRESET FWA OF MOVE
          PL     X1,SMI3     IF DOWNWARD MOVE
          IX6    X4+X1
          NG     X6,SMI2     IF DIFFERENCE BIG ENOUGH
          BX4    -X1         USE DIFFERENCE AS WORD COUNT
 SMI2     IX6    X7+X0       LWA+1 OF BLOCK TO BE MOVED
          IX2    X6-X4       FWA OF MOVE = LWA+1 - INCREMENT
          EQ     SMI4        DETERMINE BLOCK COUNT
 
 SMI3     IX6    X4-X1
          NG     X6,SMI4     IF DIFFERENCE BIG ENOUGH
          BX4    X1          USE DIFFERENCE AS WORD COUNT
 
*         DETERMINE BLOCK COUNT.
 
 SMI4     PX0    X4          WORD COUNT / TRANSFER
          PX6    X7          WORD COUNT
          NX0    X0
          FX0    X6/X0
          UX0,B4 X0
          LX6    X0,B4
          IX0    X6*X4       BLOCK COUNT
          IX3    X7-X0       REMAINDER
 
*         SET UP FOR MOVE.
 
          IX0    X2-X1       ADDRESS TO MOVE TO
          LX2    30
          BX0    X0+X2       INSERT ADDRESS TO MOVE FROM
          SB5    X4          WORD COUNT / TRANSFER
          PL     X1,SMI5     IF DOWNWARD MOVE
          BX4    -X4         COMPLEMENT INCREMENT
 SMI5     MX2    -30         BUILD INCREMENT WORD
          BX7    -X2*X4
          BX4    -X2*X4
          LX7    30
          BX4    X7+X4
          SB4    X6+         BLOCK COUNT
 
*         MOVE STORAGE (MAIN LOOP).
 
 SMI6     WE     B5          MOVE STORAGE
+         SB4    B4-B1       DECREMENT BLOCK COUNT
          IX0    X0+X4       INCREMENT/DECREMENT ADDRESSES
          GT     B4,B0,SMI6  IF NOT COMPLETE
          ZR     X3,RB6      IF NO REMAINDER
 
*         MOVE REMAINDER.
 
          SB5    X3+         REMAINING STORAGE LENGTH
          PL     X4,SMI7     IF DOWNWARD MOVE
          IX0    X0-X4       RESET LAST INCREMENT/DECREMENT
          IX0    X0-X3       DECREMENT REMAINING LENGTH
          LX3    30
          IX0    X0-X3
 SMI7     WE     B5          MOVE REMAINDER
+         JP     B6          RETURN
 VLM      SPACE  4,10
**        VLM - VERIFY FIELD LENGTH STARTUP PROCESSOR.
*
*         EXIT   TO  */MONITOR/RCC1*.
*                (VFLR) = 24/0, 18/ CPA, 18/ PP OR
*                TO  */MONITOR/PPR1*,  IF *VLFM* IN PROGRESS.
*
*         USES   X - 1, 4, 6, 7.
*                A - 1, 6.
*                B - 3, 6.
 
 
 VLM      LX1    7-36        GET CONTROL POINT
          SX4    7600B
          BX6    X4*X1
          SA1    VFLR        VFL REQUEST WORD
          SX7    2           PRESET RESPONSE
          NZ     X6,VLM1     IF CONTROL POINT SPECIFIED
          SX6    B7+
 VLM1     SX4    A5+         OUTPUT REGISTER ADDRESS
          LX6    18
          LX7    36
          SB6    VFLXP       EXCHANGE PACKAGE ADDRESS
          SB3    /MONITOR/MTRX  *RCC* RETURN ADDRESS
          BX6    X6+X4       ASSEMBLE REQUEST
          NZ     X1,PPR1     IF *VFLM* ALREADY IN PROGRESS
          SA6    A1          SET REQUEST
          EQ     /MONITOR/RCC  RECALL CPU
 VFLXP    SPACE  4,10
**        VFLXP - FIELD LENGTH VERIFICATION EXCHANGE PACKAGE.
*
*         THIS EXCHANGE PACKAGE IS USED TO VERIFY THE FIELD LENGTH
*         OF A PROGRAM AFTER A MEMORY PARITY ERROR HAS BEEN DETECTED.
*         IT MUST BE SEPARATE FROM THE REST OF THE SYSTEM BECAUSE IT
*         MAY ABORT DUE TO A HARD DOUBLE-BIT ERROR IN THE FIELD LENGTH
*         IN QUESTION.
 
 
 VFLXP    EXP    P=/CME/VFL,FL=(,MCM),FLX=(,MXM),A5=VFLR,B1=1,MA=VFLXP,E
,M=(,CXPFE)
 
*         STSW.
 
          VFD    3/ZCPS      INITIAL CPU STATUS
          VFD    57/0
 
*         CWQW.
 
          VFD    2/1
          VFD    7/MPRS      CPU PRIORITY
          VFD    1/0
          VFD    1/0         CPU SLICE ACTIVE
          VFD    1/0         RECALL FLAG
          VFD    1/1         EXTENDED CPU SLICE INCOMPLETE
          VFD    2/0
          VFD    9/0         SERVICE CYCLE
          VFD    9/SSSC*JCBE  SERVICE PARAMETERS INDEX
          VFD    1/0         *MTR* BYPASS FLAG
          VFD    2/0         NO CPU SELECTION
          VFD    3/0
          VFD    3/FVXT      FL VERIFICATION EXCHANGE PACKAGE TYPE
          VFD    18/0        *WQ* LINKAGE
 
*         CSAW.
 
          VFD    60/0
 
*         *CTMW*.
 
          VFD    60/0
 VFL      SPACE  4,10
**        VFL - VERIFY FIELD LENGTH.
*
*         ENTRY  (A5) = VFLR.
*
*         CALLS  CSM.
 
 
 VFLX     XJ                 RETURN
 
*         CLEAR CM FL.
 
 VFL      SA5    A5          GET REQUEST
          AX5    18          SHIFT TO CONTROL POINT ADDRESS
          SA2    X5+1        RA
          SA1    X5+2        FL
          AX2    36          FWA TO CLEAR
          AX1    36          WORD COUNT
          SB3    VFL1        *CSM* RETURN ADDRESS
          EQ     CSM         CLEAR STORAGE
 
*         CHECK CM FL.
 
 VFL1     SA5    A5          GET REQUEST
          AX5    18
          SA3    X5+FLSW     GET NEGATIVE FL LENGTH
          SA2    X5+1        RA
          SA1    X5+2        FL
          SX4    B1          SET INCREMENT
          AX3    48
          AX2    36          FWA
          AX1    36          WORD COUNT
          LX3    6           NEGATIVE FL OFFSET
          IX2    X2-X3       START FWA AT END OF NFL
          IX1    X1+X3       ADD NFL SIZE TO WORD COUNT
          IX1    X1-X4       PRE-DECREMENT WORD COUNT
 VFL2     ERX3   X2
          NO
          IX1    X1-X4       DECREMENT WORD COUNT
          IX2    X2+X4       INCREMENT ADDRESS
          PL     X1,VFL2     IF NOT COMPLETE
          TNO    /CME/VFL5,XUEM  (865/875 AND USER EM IN EXTERNAL EM)
 
*         CLEAR UEM FL.
 
          SA5    A5          GET REQUEST
          AX5    18          SHIFT TO CONTROL POINT ADDRESS
          SA2    X5+4        RAE
          SA1    X5+5        FLE
          AX2    36          FWA TO CLEAR
          AX1    36          WORD COUNT
          TLX2   (6,ESM170,0)
          TLX1   (6,ESM170,0)
          ZR     X1,VFL5     IF FLE = 0
          BX7    X7-X7
          SX6    B1+
 VFL2.1   WX7    X2          CLEAR USER EM
          IX1    X1-X6
          IX2    X2+X6
          NZ     X1,VFL2.1   IF NOT END OF USER EM
 
*         CHECK UEM FL.
 
 VFL3     SA5    A5          GET REQUEST
          AX5    18
          SA2    X5+4        RAE
          SA1    X5+5        FLE
          SX4    B1          SET INCREMENT
          AX2    36          FWA
          AX1    36          WORD COUNT
          TLX2   (6,ESM170,0)
          TLX1   (6,ESM170,0)
          IX1    X1-X4       PRE-DECREMENT WORD COUNT
 VFL4     RX3    X2
          NO
          IX1    X1-X4       DECREMENT WORD COUNT
          IX2    X2+X4       INCREMENT ADDRESS
          PL     X1,VFL4     IF NOT COMPLETE
 
*         SET RESPONSE.
 
 VFL5     SA5    A5          GET REQUEST
          SX6    X5          EXTRACT PP OUTPUT REGISTER ADDRESS
          SA6    A5
          EQ     VFLX        RETURN
 
 
 VFLR     VFD    24/0
          VFD    18/0        CONTROL POINT ADDRESS
          VFD    18/0        PP OUTPUT REGISTER ADDRESS
 XJ2      SPACE  4,10
**        XJ2 - ACCUMULATE ACCOUNTING ADJUSTMENTS.
*
*         EXIT   TO  */MONITOR/XJ1.1*.
*
*         USES   X - 1, 2, 4, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 6.
 
 
 XJ2      TNO    /NVE/XJ1,NVE
 XJ3      SA1    CL+CMST+A0  MONITOR MODE STATUS
          SA2    MT+A0       MONITOR MODE TIME ACCUMULATOR
          TX7    ACAD        EXCHANGE JUMP OVERHEAD FACTOR
          SX6    B0          CLEAR BASE TIME TO FLAG MONITOR MODE EXIT
          UX1,B6 X1          EXTRACT MONITOR MODE BASE TIME
          PX6    B6,X6
          ZR     B6,XJ5      IF NOT TO ACCUMULATE MONITOR MODE TIME
          RC     X4
          IX7    X2+X7       ADD EXCHANGE FACTOR
          IX5    X4-X1       MONITOR MODE TIME INCREMENT
          PL     X5,XJ4      IF NO OVERFLOW
 
*         NOTE - THE MICROSECOND CLOCK ON THE CYBER 170-865 AND 170-875
*         WILL WRAP APPROXIMATELY EVERY 1.2 HOURS, SINCE IT IS ONLY 32
*         BITS WIDE.  ALL OTHER MODELS IN THE 170-800 SERIES HAVE 48
*         BIT COUNTERS, WHICH WILL WRAP ONLY ONCE EVERY 9 YEARS OR SO.
*         SINCE THIS COUNTER IS RESET AT DEADSTART, IT IS SAFE TO
*         ASSUME THAT IF A WRAP IS DETECTED, THE COUNTER IS ONLY 32
*         BITS WIDE.
 
          SX4    1
          LX4    32
          IX5    X5+X4
 XJ4      IX7    X7+X5
          SA7    MT+A0       UPDATE MONITOR MODE TIME
 XJ5      SA6    A1          UPDATE MONITOR MODE STATUS
          EQ     /MONITOR/XJ1.1  EXCHANGE TO PROGRAM
 
          ENDBLK
          BLOCK  0CME,(NO CENTRAL MEMORY EXTENSION.)
          SPACE  4,10
 HNG      EQU    /MONITOR/HNG
 PPR1     EQU    /MONITOR/PPR1
 T1       EQU    /MONITOR/T1
 T2       EQU    /MONITOR/T2
 T3       EQU    /MONITOR/T3
 RA       EQU    /MONITOR/RA
 RA1      EQU    /MONITOR/RA1
 APQ      SPACE  4,10
**        APQ - CHECK FOR *1LT* ASSIGNMENT.
*
*         ENTRY  (X6) = REQUEST.
*
*         EXIT   (X2) = PP AVAILABILITY MASK.
*                (APQC) = NEW PP ALLOCATION MASK.
*
*         USES   X - 1, 2, 3, 4, 7.
*                A - 1, 7.
*                B - 6.
 
 APQ9     SX3    3R1LT
          MX1    18
          LX3    -18
          BX3    X3-X6
          BX1    X1*X3
          NZ     X1,/MONITOR/APQ1.0  IF NOT *1LT*
          SA1    APQD        GET ASSIGNMENT MASK
          MX3    10
          TX4    A5-1,-FP
          LX3    -12
          LX4    -3
          SB6    X4-12B
          PL     B6,APQ10    IF SECOND PP CHASSIS
          SB6    X4+
 APQ10    AX4    B6,X1       ADJUST PP MASK
          LX1    B6,X1
          BX4    X3*X4       FIRST PP CHASSIS SELECTION
          LX3    -10
          BX1    X3*X1       SECOND PP CHASSIS SELECTION
          BX7    X4+X1
          BX2    X7*X2       ALLOWABLE PP SELECTION
          SA7    /MONITOR/APQC  SET SELECTION MASK
          EQ     /MONITOR/APQ1.0  ASSIGN THE PP
 
 APQD     VFD    45/-040120060050020B,15/0
 CSM      SPACE  4,15
**        CSM - CLEAR STORAGE THROUGH CPU (MONITOR MODE).
*
*         ENTRY  (X1) = WORD COUNT.
*                (X2) = FWA.
*                (B3) = RETURN ADDRESS.
*
*         EXIT   (X7) = 0.
*
*         USES   X - 0, 1, 3, 5, 6, 7.
*                A - 3, 6, 7.
*
*         CALLS  /MONITOR/RB3.
 
 
 CSM      SA3    X2-1        GET FWA - 1
          BX7    X3
          SX0    B1
          SA7    A3          INITIALIZE A7
          MX3    -3
          BX5    -X3*X1      EXTRACT REMAINDER
          SX6    B0
          AX1    3           SET BLOCK COUNT
          BX7    X7-X7
          ZR     X1,CSM3     IF .LT. 8 WORDS TO CLEAR
 
*         CLEAR 8 WORD BLOCKS.
 
 CSM1     SA6    A7+B1
          IX1    X1-X0       DECREMENT BLOCK COUNT
          SA7    A6+1
 CSM2     SA6    A7+B1
          SA7    A6+B1
          SA6    A7+B1
          SA7    A6+B1
          SA6    A7+B1
          SA7    A6+B1
          NZ     X1,CSM1     IF NOT COMPLETE
 CSM3     ZR     X5,/MONITOR/RB3  IF COMPLETE
          IX5    X5-X0
          SA7    A7+B1       CLEAR REMAINDER
          NZ     X5,CSM3     IF NOT COMPLETE
          JP     B3          RETURN
 PLF      SPACE  4,10
**        PLF - PROCESS LOCAL FNT.
 
 
 PLF      SA3    B7+FLSW     GET RA AND NFL SIZE
          MX0    -12
          AX3    12
          BX4    -X0*X3
          AX3    36
          ZR     X3,HNG      IF NO NFL
          LX4    6
          BX6    X6-X6
          LX3    6           NFL
          SB5    X4          RA
          SA1    B5-FNTN+LENF  GET FIRST FNT ENTRY
          BX1    -X0*X5      EXTRACT NFL ADDRESS
          LX5    24
          MX0    -3
          BX2    -X0*X5      EXTRACT SUBFUNCTION
          MX0    -18
          LX5    59-41-24
          SB6    X2-TPLFL-1
          PL     B6,HNG      IF ILLEGAL SUBFUNCTION
          JP     TPLF+TPLFL+1+B6  JUMP TO PROCESSOR
 
*         EXIT TO FUNCTION PROCESSOR WITH -
*
*         (X0) = 42/-0,18/0.
*         (X1) = NFL ADDRESS/PARAMETER.
*         (X3) = NFL SIZE.
*         (X5) = REQUEST WORD LEFT-SHIFTED 59-35.
*         (A1) = ADDRESS OF FIRST FNT ENTRY.
*         (B5) = RA.
 
 TPLF     BSS    0
          LOC    0
 
+         IX4    X3-X1       (DLFS) - DELETE ENTRY
          EQ     PLF14
 
+         SX7    B1          (DLCS) - RETURN FILE COUNT
          IX4    X3-X1
          EQ     PLF14
 
*         EQ     PLF1        (CRFS) - CREATE LOCAL FNT ENTRY
 
 TPLFL    BSS    0
          LOC    *O
 
*         SET UP FOR FNT SEARCH.
 
 PLF1     SA4    A5+B1       FILE NAME
          BX6    X6-X6
          SX2    X3-FNTN     COMPUTE ADDRESS OF LAST FNT ENTRY
          SX3    LENF
          PX2    X2
          PX3    X3
          NX3    X3
          FX1    X2/X3
          BX7    X0*X4
          UX1    B6,X1
          SA2    A1-LENF
          SX3    LENF
          LX1    X1,B6
          IX3    X1*X3
          SB6    X3+FNTN
          SB3    LENF*2      SEARCH INCREMENT
          SB6    B5-B6       ADDRESS OF LAST ENTRY
          SA7    B6
          SB4    B5-FNTN     ALLOW USE OF SPECIAL FILE RESERVED ENTRY
          NG     X5,PLF4     IF SPECIAL FILE
          SB4    B4-SRFE*LENF  PREVENT USE OF RESERVED ENTRIES
 
*         SEARCH FOR MATCH OR EMPTY ENTRY.
*
*         NOTE - THE SEARCH METHOD USED THROUGHOUT THIS PROCESSOR
*                IS TO STORE THE TARGET ENTRY AT THE END OF THE
*                TABLE, THUS GUARANTEEING A MATCH.  ONCE IT IS
*                FOUND, THE LAST ENTRY IS CLEARED, AND THE ADDRESS
*                RETURNED IS CHECKED AGAINST THE LAST ENTRY.  IF
*                THEY MATCH, THE SEARCH IS DEEMED UNSUCCESSFUL.
 
 PLF4     SA1    A1-B3
          SA2    A2-B3
          BX3    X4-X1
          BX7    X4-X2
          BX3    X0*X3
          BX7    X0*X7
          ZR     X3,PLF7     IF FOUND
          ZR     X7,PLF6     IF FOUND
          ZR     X1,PLF8     IF EMPTY
 PLF4.1   NZ     X2,PLF4     IF NOT EMPTY
          SX7    A2-B4
          PL     X7,PLF4     IF USE OF RESERVED ENTRY NOT ALLOWED
          SX6    A2
          BX6    -X0*X6
 
*         EMPTY ENTRY FOUND, SEARCH FOR MATCH.
 
 PLF5     SA1    A1-B3
          SA2    A2-B3
          BX3    X4-X1
          BX7    X4-X2
          BX3    X3*X0
          BX7    X7*X0
          ZR     X3,PLF7     IF FOUND
          NZ     X7,PLF5     IF NOT FOUND
 PLF6     SA1    A2+
 PLF7     BX7    X7-X7       CLEAR LAST ENTRY
          SX3    A1-B6
          SA7    B6+
          ZR     X3,PLF10    IF LAST ENTRY
          SB4    A1
          SX3    B5-B4       NFL ADDRESS
          LX3    36          BYTE 1 OF RESPONSE
          SX7    B1          STATUS = FILE ALREADY EXISTS
          BX7    X7+X3
          EQ     PPR1        EXIT
 
*         EMPTY ENTRY FOUND.
 
 PLF8     SX7    A1-B4
          PL     X7,PLF4.1   IF USE OF RESERVED ENTRY NOT ALLOWED
          SX6    A1          SET ADDRESS OF FREE ENTRY
          BX6    -X0*X6
          EQ     PLF5        SEARCH FOR MATCH
 
*         NO MATCH FOUND, CREATE ENTRY.
 
 PLF10    SA1    B5-LFCN     INCREMENT LOCAL FILE COUNT
          SX2    X1-MXLF+SRFE+2  CHECK MAXIMUM FILE COUNT
          ZR     X6,PLF11    IF NO FREE ENTRY FOUND
          SB4    X6
          SX3    B5-B4
          SX3    X3-FNTN-SRFE*LENF-LENF
          MX7    1
          BX7    -X3*X7
          LX7    1
          IX7    X1+X7       INCREMENT FILE COUNT IF NOT SPECIAL FILE
          SX2    X7-MXLF+SRFE+1
          PL     X2,PLF11    IF FILE LIMIT EXCEEDED (MAXIMUM NFL)
          SA7    A1
          BX4    X0*X4
          SX7    LOFT*100B   SET LOCAL FILE TYPE
          BX7    X7+X4
          SA7    X6
          SX7    4           SET FST - OPERATION COMPLETE, NOT BUSY
          SA7    A7+FSTL
          SX7    B5-B4       NFL ADDRESS OF FNT ENTRY
          LX7    36
          EQ     PPR1        EXIT WITH RESPONSE
 
 PLF11    SX7    B1+B1       STATUS = LOCAL FILE LIMIT
          PL     X2,PPR1     IF FILE LIMIT EXCEEDED (MAXIMUM NFL)
          LX7    1           STATUS = NEED MORE NFL
          EQ     PPR1        EXIT
 
*         DELETE FNT ENTRY.
 
 PLF14    NG     X4,HNG      IF NFL ADDRESS OUT OF RANGE
          SB3    X1
          SA2    B5-B3       CLEAR FNT ENTRY
          ZR     X2,HNG      IF EMPTY FNT SLOT
          MX5    12
          SA4    A2+B1       READ *FST* ENTRY (FOR *DLCS* FILE COUNT)
          NZ     X7,PLF17    IF COUNTING FILES
          ERRNZ  FSTL-1
          SA6    A2
          SA6    A2+B1
          SA6    A6+B1
          ERRNZ  LENF-3
          SX4    X1-FNTN-SRFE*LENF-LENF
          MX6    1
          SA2    B5-LFCN     DECREMENT FILE COUNT IF NOT SPECIAL FILE
          BX6    -X4*X6
          LX6    1
          IX6    X2-X6
          NG     X6,HNG      IF NEGATIVE FILE COUNT
          SA6    A2
          SA2    B7+EOCW     CHECK FOR EXECUTE-ONLY FILE
          BX6    -X5*X2
          AX2    48          POSITION FNT ADDRESS
          BX1    X2-X1
          NZ     X1,PPR1     IF NOT DELETING EXECUTE-ONLY FNT
          SA6    A2
          EQ     PPR1        RETURN
 
*         COUNT FILES ON EQUIPMENT SPECIFIED IN FST.
 
 PLF17    SX6    LENF
          SX2    X3-FNTN     COMPUTE ADDRESS OF LAST FNT SLOT
          PX3    X6
          PX2    X2
          NX3    X3
          FX1    X2/X3
          SX5    B1
          UX1    B6,X1
          LX1    X1,B6
          IX3    X1*X6
          SA1    B5-FNTN+LENF+FSTL  FIRST FNT ENTRY
          SB6    X3+FNTN-FSTL
          BX6    X4          STORE SEARCH OBJECTIVE AT END OF NFL
          SB6    B5-B6
          MX7    59          INITIALIZE FILE COUNT
          SA6    B6
 PLF18    SA1    A1-LENF     READ FST ENTRY
          BX2    X4-X1
          AX2    48
          NZ     X2,PLF18    IF NOT MATCHING EST ORDINAL
          SX6    A1-B6
          IX7    X7+X5       INCREMENT FILE COUNT
          NZ     X6,PLF18    IF NOT END OF NFL
          LX7    12
          SA6    B6          CLEAR SEARCH OBJECTIVE
          EQ     PPR1        EXIT
 
          ENDBLK
          BLOCK  CMUMTR,(1 CPU MONITOR MODE CMU MOVE.),MONITOR
 MSM      SPACE  4
**        MSM - MONITOR MODE CMU MOVE.
*
*         ENTRY  (X0) = ADDRESS TO MOVE FROM.
*                (B4) = WORD COUNT OF MOVE.
*                (X1) = (X0) - ADDRESS TO MOVE TO.
*                (B6) = EXIT ADDRESS.
*
*         USES   X - 0, 1, 4, 6, 7. (*MSM* AND *MSR* REGISTER USAGE)
*                B - 4, 5.
*                A - 1, 4, 6, 7.
 
 
 MSM      SB5    X1          MOVE DIFFERENCE
          SA1    X0          FWA TO MOVE FROM
          SX1    B4          SET CHARACTER COUNT OF BLOCK
          SX0    B4+B4
          LX1    3
          MX6    -4
          IX1    X1+X0
          BX0    -X6*X1      LL
          BX1    X6*X1       LU
          LX0    30-4
          SX6    A1
          LX1    48-4
          BX1    X1+X0
          MX7    -18
          SX0    A1-B5       SET ADDRESS OF MOVE
          BX6    -X7*X6
          BX0    -X7*X0
          LX6    30
          BX0    X1+X0       MERGE CHARACTER COUNT
          BX6    X0+X6
          SA6    MSMA        STORE DESRCIPTOR WORD
          IM     MSMA
          JP     B6          RETURN
 
 MSMA     CON    0           INDIRECT MOVE DESCRIPTOR WORD
 
          ENDBLK
          BLOCK  0CMUMTR,(REGISTER MOVE.),MONITOR
 MSM      SPACE  4
**        MSR - MONITOR MODE MOVE STORAGE WITH REGISTERS.
*
*         ENTRY  (X0) = ADDRESS TO MOVE FROM.
*                (B4) = WORD COUNT OF MOVE.
*                (X1) = (X0) - ADDRESS TO MOVE TO.
*                (B6) = EXIT ADDRESS.
*
*         USES   X - 0, 1, 4, 6, 7. (*MSM* AND *MSR* REGISTER USAGE)
*                B - 4, 5.
*                A - 1, 4, 6, 7.
 
 
 MSR      SB5    X1+         MOVE DIFFERENCE
          SA1    X0+         FWA TO MOVE FROM
          SB4    B4-10B
          NG     B4,MSR2     IF LESS THAN 10B WORDS TO MOVE
 
*         REGISTER MOVE LOOP.
 
 MSR1     BX6    X1
          SB4    B4-10B      DECREMENT WORD COUNT
          SA4    A1+B1
          SA6    A1-B5
          LX7    X4
          SA1    A4+B1
          SA7    A4-B5
          BX6    X1
          SA4    A1+B1
          SA6    A1-B5
          LX7    X4
          SA1    A4+B1
          SA7    A4-B5
          BX6    X1
          SA4    A1+B1
          SA6    A1-B5
          LX7    X4
          SA1    A4+B1
          SA7    A4-B5
          BX6    X1
          SA4    A1+B1
          SA6    A1-B5
          LX7    X4
          SA1    A4+B1
          SA7    A4-B5
          PL     B4,MSR1     IF MORE 10 WORD BLOCKS TO MOVE
 MSR2     SB4    B4+10B
          EQ     MSR4
 
 MSR3     SB4    B4-B1
          BX6    X1
          SA6    A1-B5
          SA1    A1+B1
 MSR4     GT     B4,B0,MSR3  IF MORE WORDS TO MOVE
          JP     B6          RETURN
 
          ENDBLK
          BLOCK  CPP,(CONCURRENT PP REQUEST CODE.)
 CPR      SPACE  4,10
**        CPR - *CPRM* FUNCTION PROCESSOR.
*
*         ENTRY  (X1) = CALLING PARAMETERS.
*                (X7) = 0.
*
*         EXIT   (X7) = REASON CODE AND STATUS.
 
 
 CPR      BSS    0           ENTRY
          AX1    36          GET SUBFUNCTION
          SB5    /MONITOR/PPRX  ERROR EXIT ADDRESS
          MX6    -12
          SB4    X1
          SA1    CPPL
          BX6    -X6*X5      GET PARAMETER
          GT     B4,B1,CPR8  IF NOT ASSIGN OPERATION
          SB6    X6-2        DETERMINE IF REQUEST IS FOR A LEGAL BARREL
          SX7    5           RC = *INCORRECT CIO BARREL NUMBER*
          NG     B6,CPR2     IF INCORRECT BARREL PARAMETER
          GT     B6,B1,CPR2  IF INCORRECT BARREL PARAMETER
          SB3    5           SET CPP-S PER BARREL
          ZR     B6,CPR1     IF BARREL ZERO REQUESTED
          SX2    X1
          AX2    12
          SX2    X2-6
          NG     X2,CPR2     IF BARREL 1 NOT PRESENT
          SB6    50B         SET TO SCAN BARREL 1
 
*         SUBFUNCTION 0 (ASSIGN CPP).
 
 CPR1     TA3    B6,FPC
          ZR     X3,CPR3     IF FREE CPP FOUND
          SB3    B3-1
          SB6    B6+10B
          NZ     B3,CPR1     IF MORE CPP-S TO CHECK
          SX7    3           RC = *CPP NOT AVAILABLE*
 CPR2     LX7    24-0        POSITION ERROR CODES
          EQ     /MONITOR/MTRC  STORE OUTPUT REGISTER AND EXIT MONITOR
 
 CPR3     EQ     B4,B1,CPR5  IF ASSIGN AND LOAD CPP (SUBFUNCTION 1)
          SA2    CPRA        CHECK IF CALL FOR NOS/VE PP
          SA4    A5+B1
          BX2    X2-X4
          MX0    18
          BX2    X0*X2
          SB3    B7+
          SB4    CPR4        RETURN ADDRESS
          NZ     X2,WPR      IF CALL NOT FOR NOS/VE PP
          TB3    SCA         SYSTEM CONTROL POINT NUMBER
          EQ     WPR         WRITE PARAMETER WORDS
 
 CPR4     SX7    A3
          LX7    36-0        SET ST=INPUT REGISTER AND RC=0
          EQ     /MONITOR/MTRC  STORE (OR) AND EXIT MONITOR MODE
 
*         ASSIGN AND LOAD CPP (SUBFUNCTION 1).
 
 CPR5     SB3    B7          CONTROL POINT ADDRESS
          SB4    CPR6        RETURN ADDRESS
          TB7    SCA         SET CONTROL POINT FOR *1MA* CALL
          EQ     WPR         WRITE PARAMETER WORDS
 
 CPR6     SA1    A5+B1
          BX6    X1
          SB6    CPR7+400000B  RETURN ADDRESS AND CPP FLAG
          EQ     /MONITOR/SPL  SEARCH PERIPHERAL LIBRARY
 
 CPR7     BX6    X7
          SX2    B1
          SX7    7           RC = *LIBRARY LOCKED*
          NG     X1,CPR9     IF LIBRARY LOCKED
          LX2    48
          SX7    X7+B1       RC = *PROGRAM NOT FOUND*
          NZ     X5,CPR9     IF PP PROGRAM NOT FOUND
          BX7    X6+X2
          SA7    A3+B1       SET CPP OUTPUT REGISTER
          SX7    A3          SET ST = CPP INPUT REGISTER, RC = 0
          LX7    36-0
          SA7    A5
          SA1    CPRB        SET UP *1MA* CALL
          SX0    A3          *IR* OF CPP
          SX2    A5          *OR* OF CALLING PP
          LX2    12-0
          BX2    X0+X2
          BX6    X1+X2       PP CALL FORMAT
          SB4    /MONITOR/LA1MA  SET INDEX INTO *TAPQ* TABLE
          SB3    /MONITOR/MTRX  EXIT ADDRESS
          EQ     /MONITOR/APQ  ASSIGN PP
 
*         SUBFUNCTION 2 (RETURN CPP).
 
 CPR8     SB4    B4-2        CHECK SUBFUNCTION
          GT     B4,B0,/MONITOR/HNG1  IF INCORRECT SUBFUNCTION
          SX0    X1          VALIDATE THAT CPP EXISTS
          AX0    12
          SX7    4           RC = *INCORRECT CPP NUMBER*
          IX1    X0-X6
          LX6    3           MULTIPLY BY 10B
          NG     X1,CPR2     IF CPP DOES NOT EXIST
          TA3    X6,FPC
          MX0    18
          BX3    X0*X3
          SA1    CPRA
          TB3    SCA         SYSTEM CONTROL POINT NUMBER
          SX7    10001B      RC = *CPP NOT ASSIGNED*
          BX0    X1-X3
          NZ     X0,CPR2     IF CPP IS NOT ASSIGNED TO *VER*
          BX7    X7-X7
 CPR9     SA2    B3+STSW
          SA1    PPAL
          SX0    B1
          LX0    48-0
          IX6    X2-X0       DECREMENT PP COUNT AT CP
          SA6    A2
          LX0    12-48
          IX6    X0+X1       INCREMENT AVAILABLE CPP COUNT
          SA6    A1
          BX6    X6-X6       CLEAR INPUT REGISTER
          TX1    A3,-FP
          SA6    A3
          LX1    PPXES-PPCES
          TA6    X1+ACPP,FPX CLEAR CP ASSIGNMENT
          EQ     CPR2        EXIT
 
 
 CPRA     VFD    18/3L*VP,42/0  SIGNIFIES A NOS/VE PP
 CPRB     VFD    18/0L1MA,6/0,12/10B,24/0
 DDB      SPACE  4,15
**        DDB - *DDB* EXTENSION FOR CONCURRENT PPS.
*
*         *DDB* GETS CALLED WHEN IT IS NECESSARY TO DUMP A DAYFILE
*         BUFFER.
*
*         ENTRY  (A5) = REQUEST ADDRESS.
*                (B7) = CONTROL POINT ADDRESS.
*
*         EXIT   TO /MONITOR/DDB3 WITH (X0) = (B7), IF CALLED FROM CPP.
*                TO /MONITOR/DDB IF NOT CALLED FROM CPP.
*
*         USES   X - 0, 2.
*                B - 3.
*
*         CALLS  DDD.
 
 
 DDB      TX2    A5,-FPC
          NG     X2,/MONITOR/DDB  IF NOT CALLED FROM A CPP
          TX2    A5,-SP
          PL     X2,/MONITOR/DDB  IF NOT CALLED FROM A CPP
          SB3    DDB1        SET *DDD* RETURN ADDRESS
          JP     /MONITOR/DDD  ATTEMPT TO DUMP DAYFILE DIRECT
 
 DDB1     SX0    B7          WAIT FOR 1 SECTOR OF SPACE
          SX4    B6+         SET DAYFILE INDEX
          BX5    X4+X5
          JP     /MONITOR/DDB3  CHANGE FUNCTION TO *CDBM*
 DDD      SPACE  4,15
**        DDD - *DDD* EXTENSION FOR CONCURRENT PP-S.
*
*         *DDD* GETS CALLED WHEN ATTEMPTING TO INITIATE A DAYFILE
*         BUFFER DUMP BY CALLING *1DD* DIRECTLY AND THE CONTROL POINT
*         INVOLVED HAS ROLLOUT REQUESTED.  IF A *CPP* IS REQUESTING THE
*         DUMP, *1DD* WILL BE CALLED.  OTHERWISE, IT WILL NOT BE.
*
*         ENTRY  (A5) = REQUEST ADDRESS.
*                (B3) = RETURN ADDRESS FOR */MONITOR/DDD*.
*
*         EXIT   TO */MONITOR/DDD2*, IF CALLED FROM A CPP.
*                TO (B3), IF NOT CALLED FROM A CPP.
*
*         USES   X - 2.
 
 
 DDD      TX2    A5,-FPC
          NG     X2,/MONITOR/RB3  IF NOT CALLED FROM A CPP
          TX2    A5,-SP
          NG     X2,/MONITOR/DDD2  IF CALLED FROM A CPP
          JP     B3          RETURN
 DPP      SPACE  4,10
**        DPP - *DPPM* EXTENSION FOR CONCURRENT PP-S.
*
*         ENTRY  (A5) = *OR* ADDRESS OF CPP TO DROP.
*                (A2) = ADDRESS OF *ACPP*.
*
*         EXIT   TO *APQ*, TO CALL *1MA* WHICH WILL IDLE THE CPP.
*
*         USES   X - 3, 4, 6, 7.
*                A - 4, 7.
*                B - 3, 4, 7.
 
 
 DPP      BSS    0           ENTRY
          SX7    3L*MA       RESET INPUT REGISTER
          LX7    59-17
          MX4    18
          BX7    X4*X7
          SA7    A5-B1
          SA4    PPAL        INCREMENT COUNT OF AVAILABLE CPP-S
          SX3    10000B
          IX7    X4+X3
          SA7    A4
          BX7    X7-X7
          SA7    A2          CLEAR *ACPP*
          SA7    A5+         CLEAR OUTPUT REGISTER
          SB3    DPP1
          EQ     /MONITOR/JAV  CHECK JOB ADVANCE CONDITIONS
 
 DPP1     SA2    DPPA        SET PP CALL
          SX3    A5-B1       INPUT REGISTER ADDRESS
          BX6    X2+X3
          TB7    SCA         SET CONTROL POINT FOR *1MA* CALL
          SB4    /MONITOR/LA1MA  SET INDEX INTO *TAPQ* TABLE
          SB3    /MONITOR/MTRX   EXIT ADDRESS
          EQ     /MONITOR/APQ  ASSIGN PP
 
 
 DPPA     VFD    18/0L1MA,6/0,12/12B,24/0
 LMS      SPACE  4,15
**        LMS - *LMSM* EXTENSION FOR CONCURRENT PPS.
*
*         ENTRY  (X0) = 77777777777777770000B.
*                (X2) = SUBFUNCTION CODE.
*                (X6) = *WDSE* MASK = -0 IF *WDSE* PRESENT.
*
*         EXIT   (X0) = 11B.
*                (X3) = *CHRV* VALUE FROM MB+1.
*                (X4) = OLD DRIVER INDEX.
*                (X5) = *6DC*/*6DD* DRIVER INDEX.
*                (X6) = 12/0, 12/*WDSE* VALUE, 24/0, 12/2.
*                (A3) = MESSAGE BUFFER ADDRESS.
*                (B3) = SUBFUNCTION CODE.
*
*         USES   X - 0, 2, 3, 4, 5, 6, 7.
*                A - 2, 3.
*                B - 3.
 
 
 LMS13    SA3    A5+B1       GET *MB*
          SB3    X2          (B3) = SUBFUNCTION CODE
          SA2    A3+B1       GET *MB*+1
          LX5    59-44
          SX4    37B*10000B
          MI     X5,LMS14    IF *6DD* REQUEST BIT IS SET
          SX5    /MONITOR/LA6DC*10000B  SET NEW DRIVER INDEX
          EQ     LMS15       COMPLETE *6DC* LOAD PROCESSING
 
 LMS14    SX5    /MONITOR/LA6DD*10000B  SET *6DD* DRIVER INDEX
 LMS15    BX7    -X0*X2      GET *CHRV* VALUE
          BX0    X6*X0       GET *WDSE* VALUE
          LX0    36
          BX4    X4*X2
          BX0    -X0*X3
          SX6    B1+B1       INHIBIT PRESET IF *6DC* ALREADY LOADED
          LX3    X7
          BX6    X6+X0
          SX0    11B
          EQ     /MONITOR/LMS4  CHECK FOR DRIVER LOAD NEEDED
 SPL      SPACE  4,10
**        SPL - *SPLM* EXTENSION FOR CONCURRENT PPS.
*
*         ENTRY  ENTRY CONDITIONS FOR *SPL*.
*
*         EXIT   (B6) = B6 + 400000B, IF REQUEST IS FOR A CPP.
*
*         USES   X - 3, 4.
 
 
 SPL      TX3    A5,-FPC     CHECK FOR CALL FROM CPP
          TX4    A5,-SP
          NG     X3,/MONITOR/SPL  IF NOT FROM CPP
          PL     X4,/MONITOR/SPL  IF NOT FROM CPP
          SB6    B6+400000B
          EQ     /MONITOR/SPL  SEARCH PERIPHERAL LIBRARY
 
 SPL1     PL     B6,SPL2     IF REQUEST WAS FOR AN NPP
          SB6    B6-400000B
 SPL2     TJP    (/PROBE/SPL,PROBE,B6)  RETURN
          TITLE  SUBROUTINES.
 WPR      SPACE  4,15
**        WPR - WRITE PARAMETER WORDS INTO CPP-S COMMUNICATION AREA.
*
*         ENTRY  (A3) = *IR* ADDRESS OF ASSIGNED CPP.
*                (A5) = *OR* ADDRESS OF CALLING PP.
*                (B3) = CONTROL POINT ADDRESS.
*                (B4) = RETURN ADDRESS.
*
*         EXIT   TO *CPR2*, IF PP LIMIT EXCEEDED.
*                *MB* OF CALLING PP WRITTEN INTO CPP-S *IR*.
*                *MB+1* OF CALLING PP WRITTEN INTO CPP-S *MB*.
*
*         USES   X - 0, 1, 2, 4, 6, 7.
*                A - 1, 2, 4, 7.
*                B - 6.
 
 
 WPR      SA4    B3+STSW
          SX7    6           RC = *MAXIMUM PP-S ALREADY ASSIGNED*
          TX2    B3,-SCA
          MX0    -5
          LX4    0-48
          ZR     X2,WPR1     IF CALL FOR SYSTEM CONTROL POINT
          BX0    -X0*X4
          SB6    X0-NPPCP-1
          PL     B6,CPR2     IF PP LIMIT EXCEEDED
 WPR1     SX0    B1
          IX7    X4+X0       INCREMENT PP COUNT
          LX7    48-0
          SA7    A4
          SA2    PPAL
          LX0    12-0
          IX7    X2-X0       DECREMENT AVAILABLE CPP COUNT
          SA7    A2
          SA1    A5+B1
          SX2    B3          ADD CONTROL POINT NUMBER
          LX2    36-0-7
          BX7    X1+X2
          SA2    A1+B1
          BX6    X2
          SA7    A3
          SA6    A3+2        WRITE PARAMETER WORD INTO NEW CPP-S MB
 
*         IF NOT CALLED TO THE SYSTEM CONTROL POINT, AN ALTERNATE
*         ASSIGNMENT TO THE SYSTEM CONTROL POINT WILL BE SET TO ALLOW
*         A STORAGE MOVE OF THE CALLING JOB WHILE THE CPP DEADSTART IS
*         IN PROGRESS.
 
          TX7    B3,-SCA
          ZR     X7,WPR2     IF CALLED TO SYSTEM CP
          SX7    B1
          LX7    23-0        SET ALTERNATE CP FLAG
 WPR2     TX1    SCA
          BX7    X7+X1
          LX1    24
          TX2    A3,-FP
          BX7    X7+X1
          LX1    24-7
          LX2    PPXES-PPCES
          BX7    X7+X1
          TA7    X2+ACPP,FPX SET CP ASSIGNMENT
          JP     B4          RETURN
 
 
          ENDBLK
          BLOCK  PCP,(PSEUDO-CONTROL POINT CODE.)
 APC      SPACE  4,20
**        APC - ASSIGN PSEUDO-CONTROL POINT.
*
*         ENTRY  (X1) = *STSW* LEFT SHIFTED 59-31.
*                (X2) = EJT ORDINAL.
*                (X4) = EJT *JSNE* WORD.
*                (A1) = *STSW* ADDRESS.
*                (B7) = CPA ADDRESS.
*
*         EXIT   (B3) = UNCHANGED.
*                (B5) = PCP NUMBER IF ROLLOUT TO PCP POSSIBLE.
*                (B6) = -1 IF COMPOUND ROLLOUT.
*                     = 0 IF SIMPLE PSEUDO-ROLLOUT.
*                (B7) = CPA ADDRESS (UNCHANGED).
*                TO *RPC* TO INITIATE ROLLOUT TO PCP.
*                TO /MONITOR/*JAV2* IF ROLLOUT TO PCP NOT POSSIBLE.
*
*         USES   X - ALL.
*                B - 3, 4, 5, 6.
*                A - 1 - 6.
*
*         CALLS  RPC.
 
 
 APC      BSS    0           ENTRY
 
*         CHECK JOB FOR CONDITIONS PREVENTING PSEUDO-ROLLOUT.
 
          SX6    X2+
          SA2    B7+SRUW
          SA3    B7+FLIW
          SA6    APCC        SAVE EJT ORDINAL
          MX0    -12
          AX1    36-32
          SX6    4000B
          BX1    -X0*X1      ERROR FLAG
          MX7    -36
          LX2    11-41       POSITION ACCUMULATOR OVERFLOW FLAG
          BX3    -X7*X3      PENDING FL OR FLE INCREASE
          BX2    X4+X2
          IX1    X1+X3
          BX2    X6*X2       SET OVERFLOW AND SCP CONNECTION STATUS
          IX2    X1+X2
          ZR     X2,APC2     IF NO CONDITIONS PREVENTING PSEUDO-ROLLOUT
 
*         ROLL OUT JOB TO MASS STORAGE IF PSEUDO-ROLLOUT NOT POSSIBLE.
 
 APC1     SA1    B7+STSW
          MX6    -1
          LX6    31-0
          BX6    X6*X1       CLEAR PSEUDO-ROLLOUT ALLOWED FLAG
          SA6    A1
          EQ     /MONITOR/JAV2  CALL *1AJ* FOR MASS STORAGE ROLLOUT
 
*         SAVE REGISTERS AND INITIALIZE PCP SEARCH.
 
 APC2     SA1    PCPP
          SX6    A5+         SAVE (A5)
          TX3    SC          SYSTEM CP NUMBER
          SB4    X1+TFSW     PCPA FWA + *TFSW*
          SA6    APCB
          SX7    B3+         SAVE (B3)
          SB5    X3+1        FIRST PCP NUMBER
          SX6    77777B      INITIALIZE LOWEST PRIORITY
          SA1    CMCL
          SA7    APCA
          TX2    NPCP        NUMBER OF PCP-S
          LX1    -48
          BX1    -X0*X1      MOVING CP/PCP NUMBER
 
*         SEARCH FOR AVAILABLE PCP.
 
 APC3     SX2    X2-1        DECREMENT PCP INDEX
          NG     X2,APC4     IF END OF SCAN
          BX3    X2
          LX3    7           PCP INDEX * 200B
          SA4    B4+X3       READ THIS PCP-S *TFSW* WORD
          LX4    -48
          BX4    -X0*X4      EJT ORDINAL
          ZR     X4,APC5     IF FREE PCP
          SX3    B5+X2       PCP NUMBER
          BX3    X3-X1
          ZR     X3,APC3     IF PCP MOVING
          CX5    X4,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA5    X5+JSNE,EJT
          SA3    A4+STSW-TFSW
          LX5    59-0
          AX3    48
          NG     X5,APC3     IF PCP JOB INTERLOCKED
          SA5    A5+SCLE-JSNE
          AX5    54          SERVICE CLASS
          CX4    X5,JCB      CONVERT JCB ORDINAL TO OFFSET
          NZ     X3,APC3     IF ACTIVITY AT PCP
          TA4    X4+EXQT,JCB
          LX4    -12
          BX7    -X0*X4      WEIGHTING FACTOR (WF)
          SB3    X7
          LX4    -36+12
          BX4    -X0*X4      LOWER BOUND PRIORITY (LB)
          SA3    RTCL
          AX3    36          REAL TIME SECONDS (RT)
          SA5    A5+SCHE-SCLE
          LX5    36
          AX5    36          ENTRY TIME (ET)
          IX3    X3-X5       RT - ET
          AX3    X3,B3       (RT - ET) / WF
          IX4    X3+X4       PRIORITY = LB + (RT - ET) / WF
          IX5    X4-X6
          PL     X5,APC3     IF HIGHER PRIORITY THAN CURRECNT LOWEST
          SX6    X4          SET NEW LOWEST PRIORITY PCP JOB
          SB6    B5+X2       SET NEW LOWEST PRIORITY PCP NUMBER
          EQ     APC3        CONTINUE SCAN
 
*         PROCESS NO PCP AVAILABLE.  INITIATE COMPOUND ROLLOUT OF
*         LOWEST PRIORITY PCP JOB IF THAT JOB-S PRIORITY IS LOWER THAN
*         THAT OF THE CP JOB.
 
 APC4     SA3    B7+TFSW
          TA1    PCNS,SDA
          SX7    B1
          IX7    X1+X7       INCREMENT *NO PCP* COUNTER
          SA7    A1
          LX3    -48
          BX4    -X0*X3      CP JOB-S EJT ORDINAL
          CX3    X4,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA3    X3+SCHE,EJT
          BX3    -X0*X3      CP JOB-S SCHEDULING PRIORITY
          IX3    X6-X3
          PL     X3,APC7     IF LOWEST PCP PRIORITY .GE. CP JOB-S
          SX4    B6-B5       PCP INDEX
          LX4    7
          TB4    X4,PCPA     PCPA ADDRESS FOR *RPC*
          SB5    B6          PCP NUMBER FOR *RPC*
          SB6    -B1         INDICATE *APC* CALL
          EQ     APC6        INITIATE COMPOUND ROLLOUT
 
*         INITIATE ROLLOUT TO UNOCCUPIED PCP.
 
 APC5     SA1    APCC        GET EJT ORDINAL
          SB6    B0+         INDICATE SIMPLE PSEUDO-ROLLOUT TO *RPC*
          TB4    X3,PCPA     *PCPA* ADDRESS FOR *RPC*
          LX1    48
          AX3    7           PCP INDEX
          BX6    X1
          SB5    B5+X3       PCP NUMBER
          SA6    B4+TFSW     RESERVE PCP
 
*         RESTORE REGISTERS AND INITIATE PSEUDO-ROLLOUT OR COMPOUND
*         ROLLOUT.
 
 APC6     SA1    APCA        RESTORE (B3)
          SA2    A1+B1       RESTORE (A5)
          ERRNZ  APCB-APCA-1 CODE DEPENDS ON VALUE
          SB3    X1
          SA5    X2
          EQ     RPC         INITIATE PSEUDO OR COMPOUND ROLLOUT
 
*         RESTORE REGISTERS AND INITIATE ROLLOUT TO MASS STORAGE.
 
 APC7     SA1    APCA        RESTORE (B3)
          SA2    A1+B1       RESTORE (A5)
          ERRNZ  APCB-APCA-1 CODE DEPENDS ON VALUE
          SB3    X1
          SA5    X2
          EQ     APC1        INITIATE ROLLOUT TO MASS STORAGE
 
 
 APCA     CON    0           (B3) SAVE AREA
 APCB     CON    0           (A5) SAVE AREA
 APCC     CON    0           EJT ORDINAL
 RPC      SPACE  4,20
**        RPC - INITIATE PSEUDO-ROLLOUT OR PCP ROLLOUT.
*
*         ENTRY  (B3) = EXIT ADDRESS.
*                (B4) = PCPA ADDRESS.
*                (B5) = PCP NUMBER.
*                (B6) = -1 IF COMPOUND ROLLOUT.
*                     = 0 IF SIMPLE PSEUDO-ROLLOUT.
*                     .GT. 0 IF SIMPLE PCP ROLLOUT.
*                (B7) = CPA ADDRESS IF SIMPLE PSEUDO-ROLLOUT OR
*                       COMPOUND ROLLOUT.
*                     = PCPA ADDRESS IF SIMPLE PCP ROLLOUT.
*
*         EXIT   (B3) = UNCHANGED.
*                TO *APQ*.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 6.
*                B - 4, 6, 7.
*
*         CALLS  APQ.
 
 
 RPC      BSS    0           ENTRY
          SX5    B1          *1RO* FUNCTION CODE - 2
          SX7    B1
          GT     B6,B0,RPC1  IF SIMPLE PCP ROLLOUT
          TA1    POTS,SDA
          SX5    -B6
          IX6    X1+X7       INCREMENT PSEUDO-ROLLOUT COUNTER
          SA6    A1+
          EQ     B6,B0,RPC2  IF SIMPLE PSEUDO-ROLLOUT
 RPC1     TA1    PCTS,SDA    INCREMENT PCP ROLLOUT COUNTER
          SA3    B4+TFSW     GET PCP EJT ORDINAL
          IX6    X1+X7
          LX3    -48
          SA6    A1+
          MX0    -12
          BX3    -X0*X3      PCP JOB EJT ORDINAL
          CX6    X3,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA3    X6+JSNE,EJT READ PCP EJT ENTRY
          BX6    X3+X7       SET JOB INTERLOCK
          SA6    A3
 RPC2     SA2    RPCA
          SX4    B5+         PCP NUMBER
          LX5    24
          IX2    X2+X5       SET *1RO* FUNCTION CODE
          BX6    X2+X4       MERGE PCP NUMBER INTO *1RO* CALL
          SB6    B6-B1
          SB4    /MONITOR/LA1RO  SET *1RO* FAST PP LOAD TABLE INDEX
          NG     B6,/MONITOR/APQ  IF NOT SIMPLE PCP ROLLOUT
          TB7    SCA         SET SYSTEM CONTROL POINT ASSIGNMENT
          EQ     /MONITOR/APQ  ASSIGN PP
 
 
 RPCA     VFD    18/3L1RO,6/0,12/2,24/0  *1RO* REQUEST
 
          ENDBLK
          BLOCK  CP830,(CYBER 810/830 RESIDENT CODE.),MONITOR
 CSP      SPACE  4,20
**        CSP - CHECK FOR SPECIAL PP PROGRAM.
*
*         ON CYBER 810/830 MAINFRAMES WITH 20 PPS, CERTAIN PROGRAMS
*         ARE ASSIGNED ONLY TO BARREL 1.
*
*         ENTRY  (X6) = PP CALL.
*                (X2) = AVAILABLE PP FLAGS.
*                (B7) = CP ADDRESS.
*
*         EXIT   (X2) = UPDATED AVAILABLE PP FLAGS.
*                (APQC) = PP SELECTION MASK.
*
*         USES   X - 2, 3, 4, 7.
*                A - 4, 7.
 
 
 CSP      BSS    0           ENTRY
          SA4    CSPB        PRESET TABLE SEARCH
          MX3    18
          BX3    X3*X6       GET PACKAGE NAME
          LX3    18
          MX7    -18         GET PP ROUTINE
          BX7    -X7*X4
          IX7    X3-X7
          ZR     X7,CSP2     IF *1AJ* CALL
          PL     X7,CSP1     IF SYSTEM CALL (*1XX* PP NAME)
          SA4    CSPA-1      PRESET ALTERNATE TABLE SEARCH
 
*         CHECK FOR SPECIAL PP-S.
 
 CSP1     SA4    A4+B1       READ NEXT ENTRY
          MX7    -18         GET PP ROUTINE
          BX7    -X7*X4
          IX7    X3-X7
          NG     X7,APQ1.0   IF PACKAGE NAME NOT IN TABLE
          NZ     X7,CSP1     IF NO MATCH
 
*         ASSIGN SPECIFIED BARREL.
 
 CSP2     MX7    20
          LX7    -12
          BX7    X7*X4
          BX2    X7*X2
          SA7    APQC
          EQ     APQ1.0      RETURN TO *APQ*
 CSP      SPACE  4,10
****      LIST OF PP ROUTINES AND ASSOCIATED BARREL.
*
*T        12/ 0, 20/ B, 10/ 0, 18/ PP.
*         B - BARREL TO LOAD PP ROUTINE.
*         PP - PP ROUTINE NAME.
*
*         NOTE - BOTH LISTS MUST BE IN ASCENDING ALPHABETICAL ORDER.
 
 
*         SPECIAL SYSTEM ROUTINES.
 
 CSPA     VFD    12/0,20/BARREL1,10/0,18/3LCPD  *CPD*
          VFD    12/0,20/BARREL1,10/0,18/3LLDD  *LDD*
          VFD    12/0,20/BARREL1,10/0,18/3LLDQ  *LDQ*
          VFD    12/0,20/BARREL1,10/0,18/3LLDR  *LDR*
          VFD    12/0,20/BARREL1,10/0,18/3LMP3  *MP3*
          VFD    12/0,20/BARREL1,10/0,18/3LMTE  *MTE*
          VFD    12/0,20/BARREL1,10/0,18/3LNDR  *NDR*
          VFD    12/0,20/BARREL1,10/0,18/3LPFU  *PFU*
          VFD    12/0,20/BARREL1,10/0,18/3LTCS  *TCS*
          VFD    12/0,20/BARREL1,10/0,18/3LVER  *VER*
 
 CSPB     VFD    12/0,20/BARREL1,10/0,18/3L1AJ  *1AJ*
          VFD    12/0,20/BARREL1,10/0,18/3L1KB  *1KB*
          VFD    12/0,20/BARREL1,10/0,18/3L1LT  *1LT*
          VFD    12/0,20/BARREL1,10/0,18/3L1MS  *1MS*
          VFD    12/0,20/BARREL1,10/0,18/3L1MT  *1MT*
          VFD    12/0,20/BARREL1,10/0,18/3L1PC  *1PC*
          VFD    12/0,20/BARREL1,10/0,18/3L1PD  *1PD*
          VFD    12/0,20/BARREL1,10/0,18/3L1PL  *1PL*
          VFD    12/0,20/BARREL1,10/0,18/3L1PM  *1PM*
          VFD    12/0,20/BARREL1,10/0,18/3L1RI  *1RI*
          VFD    12/0,20/BARREL1,10/0,18/3L1RO  *1RO*
          VFD    12/0,20/BARREL0,10/0,18/3L1VN  *1VN*
          VFD    12/0,20/BARREL1,10/0,18/3L1VO  *1VO*
          CON    -0          END OF TABLE
 
 BARREL0  EQU    1777BS10
 BARREL1  EQU    1777B
****
 
          ENDBLK
          BLOCK  CP176,(CYBER 176 RESIDENT CODE.),MONITOR
 BNJ      SPACE  4,10
**        BNJ - EXTENSION FOR THE CYBER 176.
*
*         ENTRY  (A6) = ADDRESS-1 OF EEA REGISTER.
 
 
 BNJ30    TX7    EEAD        SET ERROR EXIT ADDRESS
          LX7    36
          SA7    A6+B1
          JP     /MONITOR/MTR  RETURN
 CJS      SPACE  4,10
**        CJS - EXTENSION FOR THE CYBER 176.
*
*         ENTRY  (B4) = RETURN ADDRESS.
*                (B6) = EXCHANGE PACKAGE ADDRESS.
 
 
 CJS7     SA4    B6+3        CLEAR PSD
          MX2    12
          LX2    -12
          BX6    -X2*X4
          SA6    A4
          JP     B4          RETURN
 CPT      SPACE  4,10
**        CPT - EXTENSION FOR THE CYBER 176.
 
 
 CP76     SA1    CXP+15B     ACCUMULATED INTERRUPT COUNT
          SA2    CL+CPBT+A0  READ BASE TIME
          TB6                READ CPU CLOCK
          MX7    -18
          SX6    B6
          BX6    -X7*X6
          IX6    X1+X6
          SA6    A2+         SET NEW BASE TIME
          IX0    X6-X2       TIME USED IN MACHINE UNITS
          EQ     /MONITOR/CPT1  COMPUTE CP TIME USED
 CXJ      SPACE  4,10
**        CXJ - CLOCK INTERRUPT NULL PROGRAM.
*
*         ENTRY  (X0) = 400000B.
*                (X5) = INTERRUPT COUNT.
 
 
 CXJ      XJ     CXP         RETURN TO CALLER
          IX5    X5+X0       COUNT EXCHANGE
          JP     CXJ         RETURN
 EXP      SPACE  4,10
**        EXP - ERROR EXCHANGE PROGRAM.
*
*         ENTRY  (X0) = 77770000777777777777B.
*                (X4) = 1.
*                (X5) = COUNT OF EXCHANGES.
 
 
 EXP      XJ     0
          SA1    B2+3        GET PSD
          MX6    3
          MX2    9
          LX6    -9
          BX6    X6*X1       EXTRACT MODE BITS
          BX2    X6+X2
          IX5    X5+X4       COUNT EXIT
          LX2    -12
          BX7    -X0*X1
          BX2    X2*X1       EXTRACT CONDITION BITS
          SX3    B2
          ZR     X7,EXP1     IF NO ERROR CONDITIONS - CPUMTR LOST
          AX2    37
          ZR     X2,EXP3     RETURN IF ERROR CONDITION PERMITTED
          LX2    -6
          LX6    11
          PL     X2,EXP1     IF NO SCM DIRECT RANGE ERROR
          LX2    1
          AX2    1           CLEAR SCM RANGE CONDITION
          MI     X6,EXP1     IF MODE  1  NOT SELECTED
          ZR     X2,EXP3     IF NO OTHER ERRORS
          SB3    EXP
 EXP1     SX7    B2
          LX3    30
          BX6    X3+X7
          SA6    B0          *ALERT* DSD
 EXP2     SB3    B3-B1
          NZ     B3,EXP2     DELAY
          SA2    B0          CHECK FOR FLAG CLEARED
          NZ     X2,EXP2     HANG UNLESS CLEARED
          SA2    B2+6        READ MA (NEA)
 EXP3     BX6    X0*X1       CLEAR CONDITION BITS AND RETURN
          SA6    A1
          JP     EXP         RETURN
 PPE      SPACE  4,20
**        PPE - PROCESS PSD ERROR.
*
*         ENTRY  (B2) = USER EXCHANGE PACKAGE ADDRESS.
*                (B3) = RA OF CONTROL POINT.
*
*         EXIT   TO *MTR1* IF NO ERRORS.
*                TO *SEF* OTHERWISE.
 
 
 PPE      SA1    B2+3        CHECK CONDITION FLAGS (PSD)
          MX6    3
          MX2    9
          LX6    -9
          BX6    X6*X1       MODE BITS
          BX2    X2+X6       ADD MASK TO CHECK ALL NON-MODE CONDITIONS
          LX2    -12
          BX2    X2*X1
          ZR     X2,/MONITOR/MTRX  IF NO ERROR CONDITION
          LX1    59-39
          TNG    X1,(/IH819/PPE,IH819,/MONITOR/MTRX)  IF STEP
          SX7    ARET        ARITHMETIC ERROR
 
*         MAP ERROR AND P ADDRESS INTO RA+0.
 
          SX6    B0+         INITIALIZE MAPPING REGISTER
          SX1    40B         CM PARITY BIT
          LX2    59-46
          PL     X2,PPE1     IF NO SCM SECDED ERROR
          BX6    X1+X6       MAP SCM SECDED AS CM PARITY
 PPE1     MX0    5           MASK FOR ADDRESS RANGE ERRORS
          LX2    1
          BX3    X0*X2
          SX1    B1          ADDRESS RANGE BIT
          MX0    2           MASK FOR INFINITE AND INDEFINTITE MODES
          ZR     X3,PPE2     IF NO RANGE ERRORS
          BX6    X1+X6       MAP ALL RANGE ERRORS AS ADDRESS RANGE
 PPE2     LX2    10          MAP OVERFLOW AND INDEFINITE
          LX0    3
          BX1    X0*X2
          BX6    X1+X6
          MX0    18          ADD P ADDRESS TO MAPPED BITS
          SA1    B2
          LX6    48
          LX0    -6
          BX1    X0*X1
          LX1    -6
          SA2    B3          INSERT MAPPED BITS AND P IN RA+0
          SA2    X2
          MX0    -30
          BX6    X1+X6
          BX2    -X0*X2
          BX6    X2+X6
          SA6    A2
          EQ     /MONITOR/SEF  SET ERROR FLAG
 TIM      SPACE  4,10
**        TIM - EXTENSION FOR THE CYBER 176.
 
 
*         ACCUMULATED JOB CLOCK CYCLE COUNT.
 
 TIM7     SB4    TIM9        SET *DSB* RETURN ADDRESS
          SA2    CPTA+A0     QUARTER NANOUNITS TO CLOCK CYCLES
          PX2    X2
          NX2    X2
          EQ     /PROGRAM/DSB  DIVIDE 60 BIT INTEGER
 
*         ACCUMULATED CLOCK CYCLE COUNT SINCE DEADSTART.
 
 TIM8     SA1    CL+CPBT+A0  READ BASE TIME
          BX6    X1
 TIM9     PX1    X6
          SB3    A5-B1       RESTORE RA
          EQ     /MONITOR/TIM1  STORE RESULT
 
          ENDBLK
          BLOCK  BUFIO,(BUFFERED I/O PROCESSING.)
 DLB      SPACE  4,10
**        DLB - DELETE BUFFER FROM I/O QUEUE.
*
*         ENTRY  (A2) = ADDRESS OF *UNCT* WORD IN *PUT* ENTRY.
*                (A3) = CONTROL BUFFER ADDRESS.
*                (B3) = RETURN ADDRESS.
*                (X2) = *UNCT* WORD OF *PUT* ENTRY.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 2, 4, 6, 7.
*                B - 5, 7.
 
 
 DLB      SA4    A3+IOLK     CHECK I/O LINKUP
          MX5    -12
          MX7    -24
          LX5    12
          LX7    24
          SX6    5000B       I/O INTERLOCK, WRITE FLAGS
          BX7    X7*X4       CLEAR QUEUE LINKAGE
          LX4    -24
          MX5    -12
          LX6    48
          BX3    -X5*X4      FORWARD LINK
          BX7    -X6*X7      CLEAR FLAGS
          LX4    -12
          SA7    A4
          BX6    -X5*X4      BACKWARD LINK
          BX7    -X5*X4
          SB7    X3+
          NZ     X6,DLB2     IF NOT FIRST BUFFER IN CHAIN
          BX2    X5*X2
          BX2    X2+X3       INSERT NEW FIRST
          EQ     DLB3        PROCESS FORWARD LINK
 
 DLB2     LX7    CBTLS       PROCESS BACKWARD LINK
          TA4    X7+IOLK,CBT
          LX4    -24
          BX7    X5*X4       FORWARD LINK
          BX7    X7+X3       INSERT NEW FORWARD LINK
          LX7    24
          SA7    A4
 DLB3     ZR     X3,DLB4     IF LAST BUFFER
          LX3    CBTLS       PROCESS FORWARD LINK
          TA4    X3+IOLK,CBT
          LX4    -36
          BX4    X5*X4       CLEAR OLD BACKWARD LINK
          BX7    X4+X6       INSERT NEW BACKWARD LINK
          LX7    36
          SA7    A4+
 DLB4     SX4    B1          DECREMENT QUEUE SIZE
          LX4    24
          LX5    12
          IX6    X2-X4
          BX3    -X5*X2      CURRENT BUFFER
          TX2    A3,-CBT     COMPUTE DELETED BUFFER ORDINAL
          LX3    -12
          AX2    CBTLS
          BX7    X3-X2
          NZ     X7,DLB6     IF NOT CURRENT BUFFER
          BX6    X5*X6       ADVANCE TO NEXT QUEUE ENTRY
          SX2    B7
          NZ     B7,DLB5     IF NOT END OF QUEUE
          SA4    A2+B1
          ERRNZ  HSCT-UNCT-1 INDEXES MUST BE CONSECUTIVE
          MX3    -12
          MX7    59
          BX2    -X3*X6      FIRST REQUEST
          LX7    58
          BX6    X7*X6       CLEAR REQUEST(S) WAITING FLAG
          BX7    X5*X4       CLEAR REQUEST COUNT
          SA7    A4
 
*         SET NEW CURRENT *CB* ORDINAL IN THE *PUT* SO AS TO EXCLUDE
*         THOSE BUFFERS CONTAINING PREVIOUSLY PROCESSED ERRORS.
 
 DLB5     SB6    DLB6
          EQ     SCB         SELECT CURRENT BUFFER IN I/O QUEUE
 
 DLB6     SA6    A2+         RESET *PUT* ENTRY
 
*         DECREMENT DEVICE ACTIVITY COUNT.
 
          SA1    A3+FSTC     EST ORDINAL
          MX3    -12
          LX1    12
          BX7    -X3*X1      EST ORDINAL
          CX4    X7,EST      CONVERT EST ORDINAL TO OFFSET
          TA4    X4+EQDE,EST READ EST ENTRY
          BX7    -X3*X4      *MST* ADDRESS/10B
          LX7    3
          SA4    X7+DALL     DECREMENT ACTIVITY COUNT
          SB5    A2+         SAVE *PUT* ENTRY ADDRESS
          SA2    X7+CTLL
          BX1    X4
          LX1    59-36
          LX2    36
          BX5    -X3*X2
          SX5    X5-1
          PL     X5,DLB7     IF NO UNDERFLOW
          SX5    0
 DLB7     BX2    X2*X3
          BX7    X2+X5
          LX7    24
          SA7    A2          UPDATE *CTLL*
          PL     X1,DLB8     IF NO RECENT *DSWM* ACCESS TO DEVICE
          LX1    59-37-59+36
          NG     X1,DLB10    IF UNIT IS BEING ACCESSED VIA *DSWM*
 DLB8     MX7    54
          BX2    X7*X5
          LX7    48
          ZR     X2,DLB9     IF NOT ACTIVITY OVERFLOW
          SX5    77B
 DLB9     BX4    X7*X4       CLEAR OLD ACTIVITY
          LX5    48
          BX7    X4+X5       ADD IN COMPUTED ACTIVITY
          SA7    A4          UPDATE *DALL*
 DLB10    LX6    59-58
          SX3    B1
          PL     X6,/MONITOR/RB3  IF *RW* FLAG CLEAR
          ERRNZ  HSCT-UNCT-1 CODE DEPENDS ON VALUE
          SA4    B5+B1
          LX3    12
          IX7    X4+X3       INCREMENT REQUESTS PROCESSED
          LX4    59-12-8
          ERRNZ  RCTH-400B   VALUE MUST BE 2**8
          NG     X4,/MONITOR/RB3  IF REQUEST COUNT LIMIT
          SA7    A4+
          JP     B3          RETURN
 HHE      SPACE  4,10
**        HHE - HANG ON HALF-EXIT.
*
*         ENTRY  VIA *RJ* SO THAT ERROR EXIT ADDRESS IS SAVED.
*
*         EXIT   NONE (IT NEVER DOES).
*
*         CALLS  MSC.
 
 
 HHE      PS                 ENTRY
          SX1    HHEA        * ESM ERROR - BUFFERED I/O.*
          SB5    HHE1        *MSC* RETURN ADDRESS
          EQ     /MONITOR/MSC  SET MESSAGE IN SYSTEM CONTROL POINT
 
 HHE1     EQ     *           HANG
 
 
 HHEA     DATA   C* ESM ERROR - BUFFERED I/O.*
 IOC      SPACE  4,25
**        IOC - I/O CONTROL.
*
*         ENTRY  (X2) = 24/ FCN, 24/ RCD, 12/CBO
*
*                FCN = 0, ENTER BUFFER IN UNIT I/O QUEUE.
*                    = 2, SET RECALL CONTROL ON BUFFER.
*                    = 3, 819 I/O RESTART.
*
*                RCD = RECALL DATA.
*
*                CBO = CONTROL BUFFER ORDINAL.
*
*         EXIT   ((B7) + 16B) = RESPONSE.
*
*                RESPONSE = 0, I/O COMPLETE.
*                           1, RECALL CONTROL SET.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 3, 4, 5, 6, 7.
*
*         CALLS  /IH819/INR.
 
 
 IOC9     SA2    A3+IOLK
          SA4    A3+LSLK
          PL     X2,IOC10    IF I/O INTERLOCK CLEAR
          SX6    1
          BX7    X4+X7
          NO
          SA7    A4+
 IOC10    TA6    16B,SCA     STORE RESPONSE
 
 IOCX     SX7    B0+         CLEAR I/O REQUEST
          TB7    SCA         SYSTEM CONTROL POINT
          TA7    IORQ
          EQ     /MONITOR/MTRX  RETURN
 
 
 IOC      MX4    -12
          BX4    -X4*X2      CONTROL BUFFER ORDINAL
          MX7    -24
          LX2    -12
          SB6    X4          CONTROL BUFFER ORDINAL
          BX7    -X7*X2      RECALL DATA
          LX2    -24
          LX4    CBTLS
          SB7    X2          FUNCTION CODE
          TA3    X4+PAD1,CBT CBT ADDRESS
          MX2    -12
          TA4    X4+HSLK,CBT GET *PUT* ORDINAL
          BX2    -X2*X4      *PUT* ORDINAL
          LX2    PUTLS
          SX6    B0+
          TA2    X2+UNCT,PUT *PUT* ENTRY
          ZR     B7,IOC0     IF ENTER BUFFER REQUEST
          SB7    B7-2
          ZR     B7,IOC9     IF TO SET RECALL CONTROL REQUEST
          TEQ    (/IH819/RIO,IH819,/BUFIO/IOCX)  RESTART 819 I/O
 
*         ENTER REQUEST IN UNIT I/O QUEUE.
 
 IOC0     MX7    -12
          SB3    B0          CLEAR FORWARD LINK
          BX1    -X7*X2      FIRST
          SB7    B1          SET INITIAL PASS
          NZ     X1,IOC1     IF NOT EMPTY QUEUE
          SX6    B6          CONTROL BUFFER ORDINAL
          BX2    X6+X2
          LX6    12
          BX2    X6+X2
          SB4    B0          CLEAR BACKWARD LINK
          SX4    B6          SET INITIAL ORDINAL
          EQ     IOC4        ENTER REQUEST IN QUEUE
 
 IOC1     SB5    X1          PREVIOUS ORDINAL
          LX1    CBTLS
          TA4    X1+PAD1,CBT OLD DISK ADDRESS
          MX1    24
          LX1    -12
          BX7    X1*X4
          BX6    X1*X3
          IX6    X7-X6
          NO
          PL     X6,IOC2     IF SLOT FOUND
          SA1    A4+IOLK-PAD1
          SX5    A4          PREVIOUS CONTROL BUFFER ADDRESS
          SB4    B5          PREVIOUS CONTROL BUFFER ORDINAL
          MX7    -12
          LX1    -24
          SB7    B0          CLEAR INITIAL PASS FLAG
          BX1    -X7*X1
          NZ     X1,IOC1     IF NOT END OF QUEUE
          LX7    36
          BX4    -X7*X4      EXTRACT CYLINDER NUMBERS
          BX7    -X7*X3
          IX7    X7-X4
          SX7    X7-CCTH
          NG     X7,IOC3     IF NOT BEYOND THRESHOLD
          SX7    B1          SET REQUEST(S) WAITING FLAG
          LX7    58
          BX2    X7+X2
          EQ     IOC3        ENTER REQUEST AT END OF QUEUE
 
 IOC2     ZR     B7,IOC3     IF NOT START OF QUEUE
          SX7    B1+
          SB3    B5          FORWARD LINK
          LX7    58
          MX6    48
          BX2    X7+X2       SET REQUEST(S) WAITING FLAG
          SB4    B0          BACKWARD LINK
          SX4    B6          INSERT NEW START OF QUEUE
          BX6    X6*X2
          BX2    X4+X6
          EQ     IOC4        ENTER BUFFER IN QUEUE
 
*         ENTER NEW CONTROL BUFFER IN UNIT I/O QUEUE.
 
 IOC3     SA3    X5+IOLK     LINK TO PREVIOUS ENTRY
          MX7    -12
          LX3    -24
          BX5    -X7*X3
          BX7    X7*X3
          SB3    X5          FORWARD LINK
          SX4    B6          NEW ENTRY ORDINAL
          BX7    X4+X7
          LX7    24
          SA7    A3+
 IOC4     LX4    CBTLS       NEW ENTRY LINK WORD
          TA3    X4+IOLK,CBT
          MX7    36
          LX3    -24
          BX7    X7*X3       CLEAR LINK FIELDS
          SX6    B4          LINK IN NEW ENTRY
          LX6    12
          BX7    X7+X6
          SX3    B3
          BX6    X3+X7
          MX7    1           SET I/O INTERLOCK
          LX6    24
          BX6    X7+X6
          LX7    24+1
          SA6    A3
          IX2    X2+X7       INCREMENT QUEUE SIZE
          ZR     B3,IOC6     IF END OF QUEUE
          LX3    CBTLS       PROCESS LINK TO NEXT ENTRY
          TA3    X3+IOLK,CBT
          MX7    48
          LX3    -36
          BX7    X7*X3       CLEAR BACKWARD LINK
          SX4    B6          NEW ENTRY ORDINAL
          BX7    X7+X4
          LX7    36
          SA7    A3+
 IOC6     LX2    -12         CHECK CURRENT *CB* ORDINAL
          MX0    -12
          SX4    B6          ORDINAL OF NEW BUFFER
          BX7    -X0*X2
          MX5    -54
          NZ     X7,IOC7     IF CURRENT *CB* PRESENT
          BX2    X2+X4
 IOC7     LX2    12
          BX6    X2          UPDATE *PUT* ENTRY
          LX4    CBTLS
          SA6    A2
 
*         INCREMENT DEVICE ACTIVITY COUNT.
 
          TA4    X4+FSTC,CBT
          LX4    12
          BX7    -X0*X4      EST ORDINAL
          CX4    X7,EST      CONVERT EST ORDINAL TO OFFSET
          TA4    X4+EQDE,EST READ EST ENTRY
          BX7    -X0*X4      MST ADDRESS / 10B
          LX7    3
          SA4    X7+DALL     INCREMENT ACTIVITY COUNT
          SX7    B1
          SA3    A4+CTLL-DALL
          LX7    24
          IX6    X3+X7
          SA6    A3
          LX6    -24
          BX3    -X0*X6      EXTRACT QUEUE SIZE
          LX4    59-37
          NG     X4,IOC8.1   IF DEVICE IS BEING ACCESSED VIA *DSWM*
          LX3    54
          SX7    X3          MOST SIGNIFICANT SIX BITS
          LX4    6-59+37
          ZR     X7,IOC8     IF NOT OVERFLOW
          MX3    6
 IOC8     BX4    -X5*X4      REMOVE OLD COUNT
          BX7    X3+X4
          LX7    -6          UPDATE COUNT
          SA7    A4
 IOC8.1   NG     X2,IOCX     IF UNIT INTERLOCKED
          TNO    /BUFIO/IOCX,IHPFMD  IF NOT 819
          MX5    1
          BX6    X5+X2       SET UNIT INTERLOCK
          LX2    -12
          BX0    -X0*X2
          SA6    A2+
          SB3    IOCX        *INR* RETURN ADDRESS
          EQ     /IH819/INR  INITIATE REQUEST
 SBR      SPACE  4,15
**        SBR - SET BUFFER RECALL.
*
*         ENTRY  (B3) = RETURN ADDRESS.
*                (A3) = CONTROL BUFFER ADDRESS.
*
*                IF 819 DEVICES -
*                (B4) = CHANNEL NUMBER.
*                (B7) = 0  IF INPUT XP, 20  IF OUTPUT XP.
*
*         USES   X - 3, 4, 6.
*                A - 4, 6.
*
*         CALLS  /IHPFMD/RPP, /IH819/RPP.
 
 
 SBR      SA4    A3+LSLK     CHECK FOR RECALL CONTROL
          MX3    36
          BX6    X3*X4       CLEAR RECALL CONTROL
          BX4    -X3*X4
          SA6    A4
          ZR     X4,/MONITOR/RB3  IF NO RECALL CONTROL SET
          BX6    X4
          AX4    18
          TNZ    X4,(/IHPFMD/RPP,IHPFMD,/IH819/RPP)  IF NOT PP RECALL
          SA4    X6          SIGNAL PP TO REISSUE
          SX3    B1
          LX3    46
          BX6    X3+X4
          SA6    A4
          JP     B3          RETURN
 SCB      SPACE  4,10
**        SCB - SELECT CURRENT BUFFER FOR I/O QUEUE.
*
*         ENTRY  (B6) = RETURN ADDRESS.
*                (X2) = ORDINAL OF FORWARD LINKED BUFFER.
*                (X6) = *UNCT* WORD WITH CURRENT *CB* FIELD CLEAR.
*
*         EXIT   (X6) = NEW *UNCT* WORD FOR *PUT* ENTRY.
*
*         USES   A - 4.
*                X - 2, 3, 4, 5, 6, 7.
 
 
 SCB      LX6    -24         POSITION UNIT QUEUE SIZE
          MX3    -12
          BX7    -X3*X6      EXTRACT QUEUE SIZE
          LX6    24
 SCB1     ZR     X7,RB6      IF QUEUE EMPTY
          LX2    CBTLS
          BX5    X6          PRESERVE *PUT* INFORMATION
          TA4    X2+HSLK,CBT
          LX2    12-CBTLS    REBUILD *UNCT* WORD
          BX6    X5+X2
          PL     X4,RB6      IF NOT *CBT* ENTRY WITH ERRORS
          MX6    -59
          SA4    A4-B1
          ERRNZ  IOLK+1-HSLK  CODE DEPENDS ON VALUE
          LX6    -1
          NO
          BX5    -X6*X5      CLEAR REQUESTS WAITING FLAG
          LX4    -24
          SX7    X7-1        DECREMENT QUEUE SIZE
          BX2    -X3*X4
          LX6    X5
          NZ     X2,SCB1     IF NOT END OF QUEUE
          SX2    X5+
          EQ     SCB1        CHECK START OF QUEUE
          TITLE  CPU MONITOR BUFFERED I/O HANDLER.
 BFM      SPACE  4,25
**        BFM - *BFMM* MONITOR FUNCTION.
*
*         ENTRY  AT *BFM* IF MONITOR MODE *BFMM* FUNCTION
*                   TO BE PROCESSED.
*                AT *BFM3* IF PROGRAM MODE *BFMM* FUNCTION
*                   TO BE PROCESSED.
*                REFER TO *BFMM* DOCUMENTATION FOR OUTPUT REGISTER
*                   AND FNT DESCRIPTION.
*
*         EXIT   TO /MONITOR/PMR TO SWITCH TO PROGRAM MODE.
*                TO /MONITOR/PPR1 TO EXIT MONITOR MODE FUNCTION.
*                TO /PROGRAM/PRG OR /PROGRAM/PRG1 TO EXIT
*                   PROGRAM MODE FUNCTION.
*                REFER TO *BFMM* DOCUMENTATION FOR OUTPUT REGISTER
*                   EXIT DISCRIPTION.
*
*         ERROR  TO /MONITOR/HNG IF INCORRECT *BFMM* OPERATION CODE
*                   OR IF INVALID SUBFUNCTION OR INVALID MULTIPLE
*                   WRITE BUFFER COUNT FOR *BMVI* OPERATION.
*                TO /PROGRAM/HNG IF NEXT TRACK NOT RESERVED WHEN
*                   ADVANCING TRACK/SECTOR FOR MULTIPLE WRITE BUFFER
*                   REQUEST.
*
*         CALLS  LBM, LMM, SNT.
 
 
*         MONITOR MODE *BFMM* ENTRY.
 
 BFM      LX1    -12
          AX1    54
          SX2    X1-BMMX
          PL     X2,/MONITOR/HNG  IF INVALID OPERATION
          SX2    X1-BMVI
          MX0    12
          LX0    -12
          BX4    X0*X5       GET MULTIPLE WRITE BUFFER COUNT
          BX5    -X0*X5      CLEAR EXTRANEOUS PARAMETERS
          NZ     X2,/MONITOR/PMR  IF NOT VALIDATE OPERATION
 
*         PROCESS *BMVI* SUBFUNCTION.
 
          MX3    -6
          BX2    -X3*X5      GET VALIDATE SUBFUNCTION
          MX0    48
          BX5    X0*X5       SET SUBFUNCTION IF VALIDATE FAILS
          ERRNZ  BMRD        INDEX MUST BE ZERO
          LX5    -12
          SX1    X5          FNT ORDINAL
          SA3    B7+FLSW     GET RA
          LX2    6
          LX5    12
          ZR     X2,BFM1     IF READ SUBFUNCTION
          SX6    X2-BMRW*100B-100B
          PL     X6,/MONITOR/HNG  IF INVALID SUBFUNCTION
          SA7    A5+B1       CLEAR *MB*
          BX5    X5+X4       RESET MULTIPLE WRITE BUFFER COUNT
          SA7    A7+B1       CLEAR *MB+1*
          LX4    18
          SX6    X4-11
          PL     X6,/MONITOR/HNG  IF BUFFER COUNT TOO LARGE
          BX5    X5+X2       SET WRITE/REWRITE OPERATION
          R=     X2,BMWR
 BFM1     NG     X4,/MONITOR/PMR  IF WRITE BUFFER ALREADY INTERLOCKED
          LX3    -RSHF
          MX7    -RMSK
          BX3    -X7*X3      RA / 100B
          LX3    6
          IX3    X3-X1       ABSOLUTE FNT ADDRESS
          SX1    B1
          IX3    X3+X1       *FST* ADDRESS
          IX1    X3+X1
          ERX1   X1          READ I/O LINK WORD
          BX7    -X0*X1
          ZR     X7,/MONITOR/PMR  IF NO LINK TO VALIDATE
          BX6    X5
          SA6    A5          UPDATE *BFMM* CALL IN OUTPUT REGISTER
          ERX3   X3          READ *FST*
          BX6    X3
          SB6    BFM2        SET RETURN ADDRESS FOR *INB*
          EQ     INB         VALIDATE AND INTERLOCK BUFFER
 
 BFM2     SA5    A5
          LX6    12
          MX7    -24
          BX7    -X7*X6
          ZR     X7,/MONITOR/PMR  IF BUFFER NOT FOUND
          MX0    -6
          LX0    11-5
          BX1    -X0*X6
          NZ     X1,/MONITOR/PPR1  IF REJECT CONDITION
          LX0    47-11
          BX6    -X0*X5
          ZR     X6,/MONITOR/PPR1  IF NOT MULTIPLE BUFFER REQUEST
          MX1    1           SET BUFFER INTERLOCKED FLAG
          SX7    B0+         CLEAR RESPONSE
          LX1    41-59
          BX5    X5+X1
          EQ     /MONITOR/PMR  SWITCH TO PROGRAM MODE
 
*         PROGRAM MODE *BFMM* ENTRY.
*         SET UP CALL TO BUFFER MANAGER.
 
 BFM3     BX2    X5
          MX0    -12
          LX2    -12
          AX2    54
          TX3    A5-1,-SP
          SB6    X2-BMFO
          ZR     X3,BFM5     IF PSEUDO PP
          SA4    A5+1
          BX6    X0*X4       CLEAR *CHRV* FIELD
          SX4    EPNS
          NG     B6,BFM4     IF NOT A FLUSH OPERATION
          BX6    X4+X6
 BFM4     SA6    A4+
 BFM5     LX1    59-41
          MX0    -36
          BX5    -X0*X5
          LX5    -12
          SB6    BFM6        SET RETURN ADDRESS FOR *LBM*
          PL     X1,LBM      IF CURRENT BUFFER NOT INTERLOCKED
          MX0    -RMSK
          EQ     BFM7        CHECK FOR MULTIPLE BUFFER REQUEST
 
 BFM6     MX0    5
          MX7    -24
          BX2    X0*X6
          LX6    12
          BX7    -X7*X6
          NZ     X2,/PROGRAM/PRG1  IF REJECT CONDITION
          MX0    -RMSK
 BFM7     SA5    A5          CHECK FOR MULTIPLE BUFFER REQUEST
          MX6    7
          LX6    47-59
          BX1    X6*X5
          ZR     X1,/PROGRAM/PRG1  IF NOT MULTIPLE BUFFER REQUEST
 
*         PROCESS MULTIPLE BUFFER WRITE REQUEST.
 
          LX5    -12
          SX2    X5          FNT ORDINAL
          SA3    B7+FLSW     GET RA
          LX3    -RSHF
          BX3    -X0*X3
          MX0    48
          LX3    6
          IX3    X3-X2       ABSOLUTE FNT ENTRY ADDRESS
          SX2    B1
          IX6    X3+X2
          ERX3   X6          GET FST ENTRY
          SA6    BAFS        SAVE FST ADDRESS
          LX1    59-41
          NG     X1,BFM8     IF CURRENT BUFFER INTERLOCKED
          IX6    X6+X2       SAVE BUFFER LINK
          ERX2   X6
          BX2    X0*X2
          AX7    12
          BX7    X7+X2
          EWX7   X6
 BFM8     SX1    X1
          ZR     X1,BFM16    IF NO MULTIPLE BUFFER COUNT
          BX6    X3          SAVE ORIGINAL FST ENTRY
          LX3    12
          SA6    BFST
          BX6    -X0*X3      GET EQUIPMENT
          CX2    X6,EST      CONVERT EST ORDINAL TO OFFSET
          TA2    X2+EQDE,EST READ EST ENTRY
          BX1    -X0*X2      MST ADDRESS/10B
          LX1    3
          SA2    X1+MDGL     GET SECTOR LIMIT
          BX2    -X0*X2
          LX1    18
          BX7    X1+X2
          LX3    -24         GET CURRENT SECTOR
          BX4    -X0*X3
          MX6    -LSLBS      CALCULATE MOD 40B OF CURRENT SECTOR
          BX4    -X6*X4
          IX6    X3-X4       CALCULATE FIRST SECTOR IN BUFFER
          SA3    BAFS        GET ABSOLUTE FST ADDRESS
          SA7    BDDC        SAVE DEVICE DESCRIPTION AND BUFFER COUNT
          LX6    12
          EWX6   X3
          SX5    BMWR*100B   SET WRITE OPERATION WITH RECALL ALLOWED
 
*         CHECK FOR END OF TRACK.
 
 BFM10    SX1    X7          SECTORS PER TRACK
          ERX3   X3          GET FST ENTRY
          SX4    LSLB        LOGICAL SECTORS PER I/O BUFFER
          LX3    -12
          IX6    X3+X4       ADVANCE TO FIRST SECTOR IN NEXT BUFFER
          BX2    -X0*X6      GET CURRENT SECTOR
          IX1    X2-X1
          NG     X1,BFM12    IF NOT END OF TRACK
          LX7    -18
          SX1    X7          MST ADDRESS
          LX6    -12
          BX0    -X0*X6      GET CURRENT TRACK
          SB6    BFM11       SET RETURN ADDRESS FOR *SNT*
          EQ     SNT         SET NEXT TRACK
 
 BFM11    PL     X2,/PROGRAM/HNG  IF NEXT TRACK NOT ASSIGNED
          MX0    36          CLEAR CURRENT TRACK AND SECTOR
          BX3    X0*X3
          LX6    12
          BX6    X3+X6       SET NEXT TRACK
 BFM12    SA1    BAFS        GET ABSOLUTE FST ADDRESS
          LX6    12
          EWX6   X1          UPDATE FST ENTRY
          LX5    -12
          SB6    BFM13       SET RETURN ADDRESS FOR *LBM*
          SA1    A5
          MX0    -24
          LX1    -12
          BX1    -X0*X1      GET CONTROL POINT AND FNT ORDINAL
          BX5    X5+X1
          EQ     LBM         CALL I/O BUFFER MANAGER
 
*         PROCESS I/O BUFFER MANAGER RESPONSE.
 
 BFM13    MX0    -12
          BX4    -X0*X6      GET BUFFER INDEX
          NG     X6,BFM18    IF BUFFER RECALL
          MX7    5
          LX1    X6,B1
          NG     X1,BFM15    IF BUFFER BUSY
          BX1    X7*X6       BUFFER MANAGER STATUS
          NZ     X1,BFM16    IF BUFFER UNAVAILABLE/INACCESSIBLE DEVICE
          MX7    1
          SA1    BDDC        GET BUFFER POSITION COUNTER
          LX7    42-59
          SA5    A5
          IX6    X5-X7       DECREMENT BUFFER COUNT
          MX3    6
          LX3    -12
          IX7    X1+X7       INCREMENT BYTE POSITION
          BX1    X3*X1
          SA2    A5+B1       GET *MB*
          LX1    -42
          SA7    A1
          SB6    X1-5
          NG     B6,BFM14    IF ROOM TO STORE LINK IN *MB*
          SA2    A2+1        GET *MB+1*
          SX1    B6+
 BFM14    LX1    2           CALCULATE BYTE INDEX * 12D
          BX5    X3*X6
          SB6    X1
          LX1    1
          SA6    A5
          SB6    X1+B6
          LX4    B6
          BX6    X2+X4
          SA6    A2
          BX6    X5
          SX5    BMWR*100B+1 SET WRITE OPERATION WITH NO RECALL
          SA3    BAFS        GET ABSOLUTE FST ADDRESS
          NZ     X6,BFM10    IF MORE BUFFERS TO REQUEST
 BFM15    SX1    0
 BFM16    SA3    BAFS        GET ABSOLUTE FST ADDRESS
          SX7    B1
          IX3    X3+X7
          ERX2   X3          RETURN FIRST BUFFER ORDINAL IN *OR*
          BX7    -X0*X2
          BX7    X7+X1       RETURN BUFFER MANAGER REPLY STATUS
          LX7    12
 BFM17    SA2    BFST        RESTORE ORIGINAL FST
          BX6    X2
          SA1    A3          GET ABSOLUTE FST ADDRESS
          EWX6   X1
          SA7    A5
          EQ     /PROGRAM/PRG  EXIT
 
*         PROCESS BUFFER RECALL (FOR SECOND BUFFER ONLY IN MULTIPLE
*         WRITE BUFFER REQUEST).
 
 BFM18    MX7    -24         RETURN RECALL ORDINAL AND STATUS
          LX6    12
          SA3    BAFS        GET ABSOLUTE FST ADDRESS
          SX2    B1
          IX1    X3+X2
          ERX2   X1          RETURN FIRST BUFFER ORDINAL IN *MB*
          BX7    -X7*X6
          BX6    -X0*X2
          SA6    A5+B1
          EQ     BFM17       RESTORE FST
 PST      SPACE  4,40
**        PST - *PIOM* SECTOR TRANSFER (SF = 0, 1, 2, 3, 4).
*
*         ENTRY  (A0) = CPU NUMBER.
*                (A5) = PP *OR* ADDRESS.
*                (X5) = (OR).
*                (B2) = EXCHANGE PACKAGE ADDRESS, IF IN MONITOR MODE.
*                (B5) = *PIOM* SUBFUNCTION - 1.
*                SEE *PIOM* DOCUMENTATION FOR *OR* AND *MB*
*                DESCRIPTION.
*                (MB+1) = 1/ MODE, 23/,18/ PROC,18/ DVI.
*                   MODE = 1 INDICATES PROGRAM MODE ENTRY.
*                   PROC = PROGRAM MODE PROCESSOR ADDRESS.
*                   DVI = DEVICE INDICATOR (0=ECS, 1=BUFFERED DEVICE)
*                PP I/O BUFFER RESERVED FOR *PIOM*
*                SUBFUNCTIONS 0, 1, 2.
*
*         EXIT   A0, A5, B5 SAME AS ON ENTRY.
*                (B2) = EXCHANGE PACKAGE ADDRESS, IF IN MONITOR MODE.
*                PARAMETERS IN *OR* AND *MB* UPDATED FOR
*                   *PIOM* SUBFUNCTIONS 3, 4.
*                (MB+1) .LT. 0, IF PROGRAM MODE EXIT,
*                   OTHERWISE MONITOR MODE EXIT.
*                TO /PROGRAM/HNG, IF SHORT PRU ENCOUNTERED AND
*                   NOT READ TO EOR (SF = 3) OR EOF/EOI ENCOUNTERED
*                   ON READ TO EOR (SF = 3, SECTOR COUNT = 7777B).
*                TO /ECS/PIOX, IF TRANSFER COMPLETE OR I/O RECALL
*                   REQUIRED.
*                TO /ECS/PIOR, IF I/O BUFFER BUSY.
*
*         CALLS  BPF, CLM, HHE, /PROGRAM/HNG, INB, /ECS/PIOP,
*                /ECS/PIOR, /ECS/PIOX, UDP.
*
*         NOTE   *PST* IS ENTERED IN PROGRAM MODE (SF = 3, 4)
*                OR MONITOR MODE (SF = 0, 1, 2).  *PST* WILL
*                SWITCH TO PROGRAM MODE IF AN I/O REQUEST
*                IS REQUIRED (SF = 0, 1, 2).
*                MB+2 AND MB+3 ARE USED TO CONTAIN A PSEUDO FNT.
 
 
*         BUILD PSEUDO FNT IN MESSAGE BUFFER.
 
 PST      SB6    PST1        *BPF* RETURN ADDRESS
          EQ     BPF         BUILD PSEUDO FNT IN MESSAGE BUFFER
 
*         VALIDATE I/O BUFFER LINK.
 
 PST1     ZR     X7,PST3     IF NO I/O BUFFER LINK
          SX2    BMRD        VALIDATE READ SUBFUNCTION
          SX1    B5+B1
          SB7    PST2        SET RETURN ADDRESS FOR *CLM*
          LX1    -1
          SB6    CLM1        RETURN ADDRESS FOR *INB*
          NG     X1,INB      IF READ OPERATION
          SX2    BMWR        VALIDATE WRITE BUFFER
          EQ     INB         INTERLOCK BUFFER
 
 PST2     ZR     X6,PST3     IF BUFFER NOT INTERLOCKED
          SA3    A5+B1
          MX7    1
          SX2    B1+
          LX3    59-6
          BX2    X7+X2
          BX6    -X2*X3
          PL     X3,PST5     IF NOT *1MV* RECALL AFTER FLUSH
          BX1    X1-X1       CLEAR STATUS / HOLD WRITE BUFFER
          NG     B5,PST38    IF RESERVE WRITE BUFFER SUBFUNCTION
          LX6    6-59
          MX1    60          CLEAR STATUS / CAUSE WRITE BUFFER RELEASE
          SA6    A3          CLEAR *1MV* ACTIVE AND LINK FLAGS
          EQ     PST38       RELEASE BUFFER AND EXIT
 
 PST3     SA3    A5+2
          SB6    PST4        SET PROGRAM MODE RETURN ADDRESS
          PL     X3,/ECS/PIOP  IF SWITCH TO PROGRAM MODE REQUIRED
 
*         REENTRY FROM PROGRAM MODE.
*         INITIATE READ OR WRITE.
 
 PST4     SX0    BMWR*100B   ALLOCATE I/O BUFFER FOR WRITE
          ERRNZ  BMWR-1      CODE DEPENDS ON VALUE
          SX6    B5+B1
          SA4    A5+B1       GET *STREAMED READ* FLAG
          LX5    6-36        CHECK FOR REWRITE
          BX2    X0*X5       0 = WRITE, 100 = REWRITE
          SB7    PST5        SET RETURN ADDRESS FOR *CLM*
          IX2    X2+X0       100 = WRITE, 200 = REWRITE
          ERRNZ  BMRW-BMWR-1 INDEXES MUST BE CONSECUTIVE
          LX6    -1
          PL     X6,CLM      IF PRU OR DIRECT WRITE OR RESERVE BUFFER
          R=     X2,0+BMRD*100B
          NZ     B5,CLM      IF DIRECT READ
          LX4    59-9
          NG     X4,CLM      IF READ STREAMING ON PRU READ
          SX2    1+BMRD*100B READ ONE BUFFER IF NO STREAMING
          EQ     CLM         CALL I/O BUFFER MANAGER
 
 PST5     SX1    B0          RETURN STATUS = NO ERROR
          MX7    1
          NG     B5,PST38    IF RESERVE WRITE BUFFER SUBFUNCTION
 
*         CALCULATE SECTOR CONTROL WORD ADDRESS.
 
 PST6     SA4    A5+B1       GET BEGINNING SECTOR
          MX2    -12
          SA1    A5+4        GET I/O BUFFER LINK (CONTROL BUFFER INDEX)
          MX3    -LSLBS      MOD 40B OF SECTOR
          LX4    -12
          BX4    -X2*X4
          LX1    CBTLS
          BX5    -X3*X4
          SB7    X5
          MX7    -24
          AX5    CBTLS       SECTOR CONTROL WORD INDEX
          TA3    X1+IOLK,CBT BUFFER ADDRESS
          IX1    X1+X5
          BX0    X3
          TA3    X1+PAD1,CBT SECTOR CONTROL WORD
          BX6    X3
          SX1    B7
          BX0    -X7*X0      I/O BUFFER ADDRESS
          LX1    6           MOD 40B OF SECTOR * 100B
          SX7    B7          MOD 40B OF SECTOR
          MX4    -3
          IX0    X0+X1       FWA DATA IN I/O BUFFER
          SX5    10000B
          BX7    -X4*X7      MOD 10B OF SECTOR
          MX3    24
          SB4    X7
          LX5    B4          POSITION MASK BIT TO CURRENT SECTOR FLAG
          SX1    B5
          LX1    -1
          MX4    2
          PL     X1,PST7     IF PRU OR DIRECT READ
          NZ     X7,PST7     IF NOT FIRST PRU OF CONTROL WORD
          SA1    A5
          LX1    59-36
          NG     X1,PST7     IF REWRITE
          LX4    23-59
          BX6    -X4*X6      CLEAR VALID DATA FLAGS
 PST7     GT     B5,B1,PST16 IF DIRECT READ OR WRITE
          SA4    A5+B1       GET PP BUFFER INCREMENT
          SB6    A0
          AX4    48
          TX4    X4,ECSB     FWA PP BUFFER
          LX0    30          SET UP FOR EXTENDED MEMORY READ/WRITE
          SA4    X4+B1       GET HEADER WORD
          SB4    B7-LSLB+1
          SX7    A4+B1       FWA DATA IN CM
          SB3    100B        SET WORD COUNT FOR TRANSFER
          BX0    X0+X7
          SA0    X7
          LX0    30          30/ABSOLUTE FWA, 30/FWA I/O BUFFER DATA
          ZR     B5,PST13    IF PRU READ
 
*         UPDATE SECTOR CONTROL WORD FOR PRU WRITE.
 
          BX7    X3*X4
          BX6    -X5*X6      CLEAR SHORT PRU FLAG
          LX4    12
          BX1    -X2*X4      SECTOR/TRACK LINKAGE
          LX4    12
          NZ     B4,PST8     IF NOT LAST PRU OF CONTROL WORD
          BX6    X2*X6       SET LINKAGE BYTE IN CONTROL WORD
          BX6    X6+X1
 PST8     ZR     X1,PST11    IF EOF/EOI
          BX1    -X2*X4      WORD COUNT
          AX1    6
          NZ     X1,PST9     IF FULL PRU
          NO
          SA1    A4+B3
          BX6    X6+X5       SET SHORT PRU FLAG
          BX1    -X3*X1
          BX7    X7+X1       MERGE HEADER INTO LAST DATA WORD
          SA7    A1
 PST9     SA6    A3          REWRITE SECTOR CONTROL WORD
          SB4    B1          SET PRU COUNT FOR TRANSFER
          EQ     PST26       TRANSFER DATA
 
*         WRITE EOI SECTOR AFTER DIRECT WRITE WHEN BUFFER FLUSH
*         REQUESTED.
 
 PST10    SA0    ESMB+1      USE PROGRAM MODE BUFFER FOR EOI DATA
          BX7    X7-X7       CLEAR FNT ENTRY IN EOI SECTOR
          SA4    A5+B1       GET EOI TRACK AND SECTOR
          MX1    12
          SA7    A0
          LX1    -12
          BX7    X1*X4       BUILD FST ENTRY FOR EOI SECTOR
          MX2    -24
          LX4    -12
          BX1    -X2*X4
          BX7    X1+X7
          LX7    12
          SA1    PDTL        GET PACKED DATE AND TIME
          SA7    A7+B1
          BX7    X1
          SX1    A0
          SA7    A7+B1
          LX1    30
          IX0    X0+X1
          SB3    B1
          MX1    -6
          SB5    B5+B1
          WE     3           WRITE EOI SECTOR SYSTEM INFORMATION
          RJ     HHE         HANG ON HALF-EXIT
          SA4    A0-B3       SET TO TRANSFER EOI LINKAGE
          BX7    X7-X7
          SX4    B0
          IX0    X0-X1       ADVANCE DATA TRANSFER ADDRESS
 PST11    BX1    -X2*X4      NEXT SECTOR / TRACK LINKAGE
          SA7    A4+B3       SAVE HEADER WORD AS LAST DATA WORD
          BX6    X6+X5       SET SHORT PRU FLAG
          NZ     B4,PST12    IF NOT LAST PRU OF CONTROL WORD
          BX6    X6+X1       MERGE LINKAGE DATA
 PST12    NZ     X1,PST9     IF EOF
          SA2    A5+4        GET I/O BUFFER LINK
          SB4    PST9        SET RETURN ADDRESS FOR *IDE*
          LX2    CBTLS
          SX7    B7
          TX3    X2+PAD1,CBT ADDRESS OF FIRST SECTOR CONTROL WORD
          EQ     IDE         SET FLAGS TO IGNORE DATA AFTER EOI
 
*         BUILD HEADER WORD FOR PRU READ.
 
 PST13    BX7    X5*X6       CHECK FOR SHORT PRU
          NZ     X7,PST14    IF SHORT PRU
          SA4    A5+B1
          SX1    B3+         WORD COUNT
          LX4    -12         GET CURRENT SECTOR
          BX4    -X2*X4
          LX1    36
          SX7    X4+B1       NEXT SECTOR
          LX7    -12
          BX7    X7+X1
          NZ     B4,PST15    IF NOT LAST PRU OF CONTROL WORD
          BX7    -X2*X6      GET LINKAGE BYTE FROM CONTROL WORD
          LX7    -12
          BX7    X7+X1
          EQ     PST15       SAVE HEADER WORD
 
 PST14    SX1    B3-B1       GET HEADER WORD FROM LAST DATA WORD
          BX7    X0          SAVE (X0)
          LX0    30
          SB4    A0          SAVE (A0)
          AX0    30
          SA2    A5+2        GET PROGRAM/MONITOR MODE FLAG
          MX6    1
          BX2    X6*X2
          LX2    1
          SA0    ESMB+X2
          IX1    X0+X1
          SX0    A0
          LX0    30
          BX0    X0+X1
          RE     1           READ HEADER WORD
          RJ     HHE         HANG ON HALF-EXIT
          SA1    ESMB+X2
          SA0    B4+         RESTORE (A0)
          BX0    X7          RESTORE (X0)
          BX7    X1          MOVE HEADER WORD
 PST15    SA7    A0-B1       SAVE HEADER WORD IN PP BUFFER
          SB4    B1          SET PRU COUNT FOR TRANSFER
          EQ     PST29       TRANSFER DATA
 
*         CALCULATE NUMBER OF PRUS (1 TO LSLB) TO TRANSFER THIS PASS.
*         FOR DIRECT READ OR WRITE.
 
 PST16    SX1    B7-LSLB
          SB5    B5-B1
          BX1    -X1
          SA4    A5          GET SECTOR COUNT
          SB4    X1
          SB3    B0
          LX4    59-38       CHECK FOR READ TO EOR
          SB6    B0
          NG     X4,PST17    IF READ TO EOR
          AX4    24+59-38
          BX2    -X2*X4
          IX7    X2-X1
          PL     X7,PST17    IF SECTOR COUNT NOT EXHAUSTED
          ZR     X2,PST10    IF WRITE EOI AFTER DIRECT TRANSFER
          SB4    X2+0
 PST17    SX1    100B
          GT     B5,B1,PST21 IF DIRECT WRITE
 
*         PROCESS DIRECT READ.
 
 PST18    LX5    59-20
          PL     X5,PST19    IF NOT END OF DISK SECTOR
          SX5    B1
          SA3    A3+1        GET NEXT SECTOR CONTROL WORD
          LX5    12+59-20
          BX6    X3
 PST19    LX5    -59+20
          BX7    X5*X6       EXTRACT SHORT PRU FLAG
          LX5    1           POSITION SHORT PRU MASK FOR NEXT PRU
          MX2    -12
          ZR     X7,PST20    IF FULL PRU
          PL     X4,/PROGRAM/HNG  IF NOT READ TO EOR
          SX1    B6          GET HEADER WORD FROM LAST DATA WORD
          LX1    6
          SB4    A0+0        SAVE (A0)
          SX1    X1+77B
          BX7    X0          SAVE (X0)
          LX0    30
          SA0    ESMB+1      USE PROGRAM MODE BUFFER
          AX0    30
          IX1    X0+X1
          SX0    A0+0
          LX0    30
          BX0    X0+X1
          RE     1           READ HEADER WORD
          RJ     HHE         HANG ON HALF-EXIT
          SA1    ESMB+1
          SA0    B4          RESTORE (A0)
          BX0    X7          RESTORE (X0)
          SB4    B6+B1
          LX1    12
          BX7    -X2*X1
          AX1    48          WORD COUNT
          NZ     X7,PST20    IF NOT EOF/EOI
          BX2    X1
          SX1    B0          WORD COUNT = 0
          NZ     X2,PST20    IF EOF
          SB6    B6-B1       RESET PRU COUNT TO PRECEED EOI
          SB4    B4-B1
 PST20    SB6    B6+B1
          SB3    B3+X1       INCREMENT WORD COUNT OF TRANSFER
          LT     B6,B4,PST18 IF MORE PRUS TO CHECK
          SB2    PST24       SET RETURN ADDRESS FOR *UDP*
          EQ     UDP         UPDATE DIRECT TRANSFER PARAMETERS
 
*         PROCESS DIRECT WRITE.
 
 PST21    LX5    59-20
          NG     X5,PST23    IF END OF DISK SECTOR
          LX5    -59+20
 PST22    SB6    B6+B1
          BX6    -X5*X6      CLEAR SHORT PRU FLAG
          SB3    B3+X1       INCREMENT WORD COUNT
          LX5    1
          LT     B6,B4,PST21 IF MORE PRUS
          SB2    PST24       SET RETURN ADDRESS
          SA6    A3          REWRITE SECTOR CONTROL WORD
          EQ     UDP         UPDATE DIRECT TRANSFER PARAMETERS
 
 PST23    SA6    A3          STORE SECTOR CONTROL WORD
          SA4    A5          CHECK REWRITE STATUS
          SA3    A3+B1       READ NEXT SECTOR CONTROL WORD
          LX4    59-36
          SX5    10000B
          BX6    X3
          MX7    2
          NG     X4,PST22    IF REWRITE
          LX7    23-59
          BX6    -X7*X6      CLEAR VALID DATA FLAGS
          EQ     PST22       CONTINUE PROCESSING
 
*         *PIOM* DIRECT TRANSFER PARAMETERS UPDATED
*         (TRACK, SECTOR, SECTOR COUNT, SECTORS TRANSFERRED,
*         AND CM ADDRESS FOR TRANSFER).
 
 PST24    SA0    X5          ABSOLUTE CM ADDRESS OF TRANSFER
          LX0    30
          MX7    -30
          BX0    X7*X0
          BX7    -X7*X5
          BX0    X0+X7
          LX0    30
          SX7    B5-B1
          MX2    -12
          SB5    B5+B1
          ZR     X7,PST29    IF DIRECT READ
          SA1    A3+0
          PL     X6,PST25    IF ADVANCE TO NEXT TRACK
          SA4    A5+1
          MX7    -3
          LX4    -12
          BX6    -X2*X4
          BX7    -X7*X4
          NZ     X7,PST26    IF NOT LAST PRU OF CONTROL WORD
 PST25    BX1    X2*X1
          BX6    X6+X1       SAVE LINKAGE INFORMATION
          SA6    A3          REWRITE SECTOR CONTROL WORD
 
*         TRANSFER DATA FROM PP BUFFER TO I/O BUFFER OR DIRECT FROM
*         CONTROL POINT FIELD LENGTH TO I/O BUFFER.
 
 PST26    SX7    B2          SAVE (B2)
          SB2    BTSZ
          SX1    B0
          GE     B2,B3,PST28 IF ONE BLOCK OR LESS TO WRITE
          SA1    PSTA        GET ADDRESS INCREMENT WORD
 PST27    WE     BTSZ
          RJ     HHE         HANG ON HALF EXIT
          SB2    B2+BTSZ
          SA0    A0+BTSZ     INCREMENT ADDRESSES
 PST28    IX0    X0+X1
          LT     B2,B3,PST27 IF MORE FULL BLOCKS TO TRANSFER
          SB2    B3-B2
          WE     B2+BTSZ     WRITE REMAINDER OF BLOCK
          RJ     HHE         HANG ON HALF-EXIT
          EQ     PST32       CHECK FOR TRANSFER COMPLETION
 
*         TRANSFER DATA FROM I/O BUFFER TO PP BUFFER OR DIRECT FROM
*         I/O BUFFER TO CONTROL POINT FIELD LENGTH.
 
 PST29    SX7    B2          SAVE (B2)
          SB2    BTSZ
          SX1    B0
          GE     B2,B3,PST31 IF ONE BLOCK OR LESS TO READ
          SA1    PSTA        GET ADDRESS INCREMENT WORD
 PST30    RE     BTSZ
          RJ     HHE         HANG ON HALF-EXIT
          SB2    B2+BTSZ
          SA0    A0+BTSZ     INCREMENT ADDRESSES
 PST31    IX0    X0+X1
          LT     B2,B3,PST30 IF MORE FULL BLOCKS TO TRANSFER
          SB2    B3-B2
          RE     B2+BTSZ     READ REMAINDER OF BLOCK
          RJ     HHE         HANG ON HALF-EXIT
 
*         DETERMINE IF TRANSFER COMPLETE.
 
 PST32    SB7    B7+B4
          SB2    X7          RESTORE (B2)
          SA0    B6          RESTORE (A0) FOR PRU READ/WRITE
          SX7    B1
          SX3    B5
          SB7    B7-LSLB
          LX7    48-0
          SA4    A5          GET PARAMETERS
          LX3    -1
          SX1    IFLS        RETURN STATUS = INSUFFICIENT FL
          NG     X5,PST38    IF TRANSFER TERMINATED FOR READ TO EOR
          SX1    B0+         RETURN STATUS = NO ERROR
          LE     B5,B1,PST34 IF PRU TRANSFER
          SX0    B4          PRUS TRANSFERRED
          LX4    -24
          MX6    -12
          LX0    6
          SX2    B3+         WORD COUNT OF TRANSFER
          BX6    -X6*X4      REMAINING SECTOR COUNT
          IX2    X2-X0
          NG     X2,PST34    IF EOR ENCOUNTERED OR EOI WRITTEN
          ZR     B3,PST34    IF EOR/EOF/EOI ENCOUNTERED
          LX4    0-37+24     CHECK FOR EOR READ OR WRITE EOI
          MX0    -2
          BX0    -X0*X4
          BX6    X6+X0
          ZR     X6,PST34    IF SECTOR COUNT EXHAUSTED
          NZ     B7,PST6     IF NOT LAST PRU IN 4K BLOCK
          SB6    PST33       SET RETURN ADDRESS FOR *BPF*
          EQ     BPF         REBUILD PSEUDO FNT
 
 PST33    SX2    BMRG*100B   RELEASE BUFFER AND GET NEXT BUFFER
          SB7    PST6        SET RETURN ADDRESS FOR *CLM*
          PL     X3,CLM      IF DIRECT READ
 
*         NOTE - IF SUPPORT FOR A DIRECT REWRITE OPERATION IS EVER
*         NEEDED, CODE CAN BE ADDED HERE TO CHECK THE REWRITE FLAG
*         AND IF SET, SET FUNCTION *BMRW* INSTEAD OF *BMWR*.
 
          SX2    BMRF*100B+BMWR  FLUSH WRITE BUFFER AND GET NEXT ONE
          EQ     CLM         CALL I/O BUFFER MANAGER
 
*         TRANSFER COMPLETE.  RELEASE I/O BUFFER.
 
 PST34    SA5    A5          CHECK FOR BUFFER FLUSH
          MX2    42
          PL     X3,PST35    IF PRU READ OR DIRECT READ
          LX7    59-0-48+0
          LX5    59-37
          PL     X5,PST35    IF NO BUFFER FLUSH REQUESTED
          SB7    B0+         FORCE FLUSH AND PP BUFFER RELEASE
          BX1    -X1
 PST35    NZ     B7,PST38    IF NOT LAST PRU IN 4K BLOCK
          SA3    A5+2        GET PROGRAM MODE FLAG
          BX1    -X2*X1      SAVE RETURN STATUS IN MESSAGE BUFFER
          BX3    X2*X3
          SB6    PST36       SET PROGRAM MODE RETURN ADDRESS
          BX6    X1+X3
          SA6    A3
          PL     X3,/ECS/PIOP  IF SWITCH TO PROGRAM MODE REQUIRED
 
*         REENTRY FROM PROGRAM MODE.
*         CALL I/O BUFFER MANAGER TO RELEASE READ BUFFER OR TO
*         RELEASE WRITE BUFFER AND FLUSH THE BUFFER TO DISK.
 
 PST36    SX4    B5
          SB7    PST37       SET RETURN ADDRESS FOR *CLM*
          LX4    -1
          SX2    BMRB*100B   RELEASE READ BUFFER
          PL     X4,CLM      IF PRU READ OR DIRECT READ
          SX2    BMRF*100B   RELEASE WRITE BUFFER AND FLUSH TO DISK
          EQ     CLM         CALL I/O BUFFER MANAGER
 
 PST37    SA1    A4+B1       RESTORE RETURN STATUS
          SX1    X1
          EQ     /ECS/PIOX   EXIT
 
*         RELEASE I/O BUFFER ASSIGNMENT.
 
 PST38    SA2    A5+4        GET I/O BUFFER LINK
          NO
          LX2    CBTLS
 +        TA3    X2+LSLK,CBT ** RELEASE BUFFER (UPDATE IN ONE WORD)
          IX6    X3-X7       **
          SA6    A3          **
          EQ     /ECS/PIOX   EXIT
 
 
 PSTA     VFD    30/BTSZ,30/BTSZ  ADDRESS INCREMENTS
 
 ESMB     BSS    1           MONITOR MODE EXTENDED MEMORY WORD BUFFER
          BSS    3           PROGRAM MODE EXTENDED MEMORY WORD BUFFER
 PBF      SPACE  4,15
**        PBF - *PIOM* BUFFER FLUSH (SF=5).  PROGRAM MODE.
*
*         ENTRY  (A0) = CPU NUMBER.
*                (A5) = PP *OR* ADDRESS.
*                (B7) = CP ADDRESS.
*                SEE *PIOM* DOCUMENTATION FOR *OR* AND *MB*
*                   DESCRIPTION.
*
*         EXIT   A0, A5, B7 SAME AS ON ENTRY.
*                TO /PROGRAM/PRG, AFTER BUFFER FLUSH INITIATED.
*
*         USES   A - 1, 7.
*                B - 6.
*                X - 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  BPF, LBM.
 
 
 PBF      MX7    -12
          SX1    BMFL        SELECT BUFFER FLUSH FUNCTION
          BX6    -X7*X5      EXTRACT FNT ORDINAL
          SX7    EPNS        ALLOW FLUSH ON *OFF* DEVICE
          SX2    B7          CP NUMBER
          LX2    18-7
          BX5    X2+X6
          LX1    -6
          TX4    A5-1,-SP
          SB6    PBF2        SET RETURN ADDRESS FOR *LBM*
          BX5    X5+X1
          EQ     LBM         CALL I/O BUFFER MANAGER
 
 
*         THE BUFFER INDEX IS NOT CLEARED FOR A DIRECT ACCESS FILE
*         SO THAT A DETERMINATION CAN BE MADE ON THE NEXT I/O OPERATION
*         AS TO WHETHER THE BUFFER HAS BEEN WRITTEN TO THE DEVICE.
 
 PBF2     SA1    FNTA        CLEAR BUFFER INDEX
          SX2    PMFT*100B
          ERX3   X1          READ FNT
          SX6    7700B
          BX2    X2-X3
          BX7    X7-X7
          BX6    X6*X2
          ZR     X6,/PROGRAM/PRG1  IF DIRECT ACCESS FILE
          R=     X2,FUTL     CLEAR BUFFER INDEX IN FST
          IX2    X1+X2
          ERX1   X2
          MX3    48
          BX6    X3*X1
          EWX6   X2
          EQ     /PROGRAM/PRG1  EXIT AND CLEAR OUTPUT REGISTER
 BPF      SPACE  4,20
**        BPF - BUILD PSEUDO FNT IN PP MESSAGE BUFFER.
*
*         ENTRY  REFER TO *PIOM* FOR DESCRIPTION OF *MB*.
*                (A5) = *OR* ADDRESS.
*                (B6) = RETURN ADDRESS.
*
*         EXIT   (MB+2) = 12/EQUIPMENT,12/0,12/TRACK,12/SECTOR,12/0.
*                (MB+3) = 48/0,12/I/O BUFFER LINK.
*                (X6) = *FST*.
*                (X7) = I/O BUFFER LINK, IF NONZERO.
*
*         USES   A - 1, 4, 6, 7.
*                X - 1, 4, 6, 7.
 
 
 BPF      SA4    A5+B1       GET PARAMETERS FROM MESSAGE BUFFER
          MX1    -24
          LX1    12
          MX6    12
          BX1    -X1*X4      TRACK AND SECTOR
          LX4    12
          MX7    0
          BX6    X6*X4       EQUIPMENT
          LX4    59-7-12
          BX6    X6+X1
          SA6    A5+3        SAVE PSEUDO FNT IN MESSAGE BUFFER
          PL     X4,BPF1     IF NO I/O BUFFER LINK
          TX1    A5-1,-FP    CALCULATE PP INDEX
          AX1    3           PP INDEX INTO *PLT*
          TA1    X1,PLT      READ PP I/O BUFFER LINK
          BX7    X1
 BPF1     SA7    A6+B1       SAVE I/O BUFFER LINK IN PSEUDO FNT
          JP     B6          RETURN
 CLM      SPACE  4,35
**        CLM - CALL I/O BUFFER MANAGER.
*
*         ENTRY  (B7) = RETURN ADDRESS.
*                (A5) = *OR* ADDRESS.
*                (X2) = 48/0,6/ OP,6/ BC.
*                   OP = I/O BUFFER MANAGER OPERATION.
*                   BC = BUFFER COUNT (USED FOR ONLY *BMRD* AND *BMRF*
*                        OPERATIONS).
*                        FOR *BMRD*, BC = 1 IF NON-STREAMED PRU READ.
*                        FOR *BMRF*, BC = *BMWR* IF WRITE.
*                                    BC = *BMRW* IF REWRITE.
*                (MB+1) .LT. 0, IF PROGRAM MODE.
*                (MB+2) = PSEUDO FNT EQUIPMENT, TRACK, SECTOR.
*                (MB+3) = PSEUDO FNT I/O BUFFER LINK (CONTROL BUFFER
*                   INDEX) FOR OP = 4, 5, 6.
*
*         EXIT   A0, A5, B2 SAME AS ON ENTRY.
*                (B5) = *PIOM* SUBFUNCTION - 1.
*                (A4) = *MB* ADDRESS.
*                (X5) = (OR).
*                (X6) = BUFFER ORDINAL.
*                     = 0 IF NO BUFFER INTERLOCKED.
*                (MB) = I/O BUFFER LINK FLAG UPDATED.
*                (MB+3) = I/O BUFFER LINK UPDATED.
*                BUFFER LINK FOR THIS PP UPDATED IN *PLT*.
*                TO /ECS/PIOR, IF I/O BUFFER BUSY.
*                TO /ECS/PIOX, IF RECALL REQUIRED, I/O ERROR, ADDRESS
*                   ERROR OR INACCESSIBLE DEVICE.
*
*         USES   A - 3, 4, 6, 7.
*                B - 5, 6.
*                X - ALL.
*
*         CALLS  LBM, /ECS/PIOR, /ECS/PIOX.
 
 
 CLM      SX1    A5+2        PSEUDO FNT ADDRESS
          LX2    -12
          BX5    X1+X2
          SB6    CLM1        SET *LBM* EXIT ADDRESS
          EQ     LBM         CALL BUFFER MANAGER
 
*         CHECK BUFFER STATUS.  SAVE I/O BUFFER LINK.
*         ENTRY FROM *INB* IN MONITOR MODE.
 
 CLM1     UX0,B5 X5
          SA4    A5+B1
          AX0    42
          MX1    1
          SB5    X0-1        *PIOM* SUBFUNCTION - 1
          SX7    X6          BUFFER ORDINAL (IF INTERLOCKED)
          MX0    5
          BX2    X0*X6       BUFFER MANAGER STATUS
          SA7    A5+4        UPDATE PSEUDO FNT
          LX1    7-59
          SX6    X6          BUFFER ORDINAL (0 IF NOT INTERLOCKED)
          BX7    -X1*X4      CLEAR PP BUFFER RESERVED FLAG
          ZR     X6,CLM2     IF BUFFER NOT INTERLOCKED
          TX3    A5-1,-FP
          AX3    3
          BX7    X1+X4       SET PP BUFFER RESERVED FLAG
          TA6    X3,PLT      STORE PLT ENTRY
 CLM2     SA7    A4          UPDATE *CHRV* IN MESSAGE BUFFER
          MX4    1
          NZ     X2,CLM3     IF BUFFER MANAGER STATUS NONZERO
          JP     B7          EXIT
 
 CLM3     SX1    -RCLS       SET RECALL STATUS
          NG     X2,/ECS/PIOX  IF RECALL
          LX2    59-58
          SX3    B5+B1       *PIOM* SUBFUNCTION
          NG     X2,/ECS/PIOR  IF BUFFER BUSY
          LX3    -1
          PL     X3,CLM4     IF WRITE REQUEST
          LX4    48-59
 CLM4     BX1    X6
          ZR     X6,CLM5     IF BUFFER NOT INTERLOCKED
          LX1    CBTLS
+         TA3    X1+LSLK,CBT **** PERFORM IN ONE WORD ****
          IX6    X3-X4       **** PERFORM IN ONE WORD ****
          SA6    A3          **** PERFORM IN ONE WORD ****
 CLM5     LX3    X2,B1
          LX2    X3,B1
          PL     X3,CLM6     IF NOT I/O ERROR
          SX4    B1
          LX4    6
          BX7    -X4*X7
          SA7    A7          CLEAR *1MV* FLUSH FLAG
          SA1    A5+2        CHECK PROGRAM MODE FLAG IN (MB+1)
          SA3    FCBI        BUFFER WITH ERROR (PROGRAM MODE)
          NG     X1,CLM5.1   IF PROGRAM MODE
          SA3    FCBM        BUFFER WITH ERROR (MONITOR MODE)
 CLM5.1   MX0    -6
          LX3    CBTLS
          TA1    X3+HSLK,CBT
          LX1    -48
          BX1    -X0*X1      ERROR CODE FROM DRIVER
          BX1    -X1         CAUSE PP I/O BUFFER RELEASE
          EQ     /ECS/PIOX   EXIT
 
 CLM6     SX1    -ADDE
          PL     X2,/ECS/PIOX  IF ADDRESS ERROR
          SX1    -LNRE       SET *LOGICAL NOT READY* ERROR STATUS
          EQ     /ECS/PIOX   EXIT
 IDE      SPACE  4,10
**        IDE - IGNORE DATA AFTER EOI WRITE.
*
*         ENTRY  (B4) = RETURN ADDRESS.
*                (X3) = FWA CONTROL BUFFER.
*                (X7) = MOD 40B OF SECTOR CONTAINING EOI.
*
*         USES   A - 2, 7.
*                X - 1, 2, 7.
 
 
 IDE      BSS    0           ENTRY
          SX1    X7
          AX7    CBTLS
          IX2    X3+X7
          SA2    X2          CONTROL WORD CONTAINING EOI
          SX7    B1
          LX1    -2
          BX1    -X1*X7      SET SECOND SECTOR FLAG ONLY OR NO FLAG
 IDE1     LX1    22-0        POSITION VALID DATA FLAGS
          BX7    X2+X1
          SA7    A2+         REWRITE CONTROL WORD
          SX7    A2-PAD4
          IX7    X7-X3
          ZR     X7,/MONITOR/RB4  IF LAST CONTROL WORD COMPLETED
          SX1    3           SET BOTH FLAGS
          SA2    A2+1        GET NEXT CONTROL WORD
          EQ     IDE1        COMPLETE REMAINING CONTROL WORDS
 UDP      SPACE  4,30
**        UDP - UPDATE *PIOM* DIRECT TRANSFER PARAMETERS.
*
*         ENTRY  (A5) = PP *OR* ADDRESS.
*                (B2) = RETURN ADDRESS.
*                (B3) = WORD COUNT OF TRANSFER.
*                (B4) = NUMBER OF SECTORS TO TRANSFER.
*                SEE *PIOM* DOCUMENTATION FOR *OR* AND *MB*
*                   DESCRIPTION.
*
*         EXIT   PARAMETERS IN *OR* AND *MB* ADVANCED
*                   BY SPECIFIED SECTOR AND WORD COUNT.
*                   ADVANCES TO NEXT TRACK IF NECESSARY.
*                (B3) = WORD COUNT OF TRANSFER, UPDATED IF TRANSFER
*                   PREMATURELY TERMINATED.
*                (B4) = SECTOR COUNT OF TRANSFER, UPDATED IF TRANSFER
*                   PREMATURELY TERMINATED.
*                (X6) .LT. 0, IF NO ADVANCE TO NEXT TRACK.
*                (X6) .GT. 0, NEXT TRACK.
*                (X5) = ABSOLUTE CM ADDRESS TO BEGIN TRANSFER, AND
*                   INSUFFICIENT FL FLAG (IF BIT 59 SET).
*                TO /PROGRAM/HNG, IF NEXT TRACK NOT RESERVED,
*                   IF SECTOR COUNT TRANSFER ATTEMPTED BEYOND FL,
*                   OR IF LWA SPECIFICATION INVALID FOR READ TO EOR.
*
*         USES   A - 0, 1, 2, 4, 5, 7.
*                B - 3, 4, 6.
*                X - 1, 2, 4, 5, 6, 7.
 
 
 UDP      BSS    0           ENTRY
          TX4    A5-1,-FP
          LX4    PPXES-PPCES
          MX1    -12
          TA4    X4+ACPP,FPX GET CP/PCP ASSIGNMENT
          SA5    A5+         GET *OR* PARAMETERS
          LX4    -24
          SX7    X4+         CP/PCP ADDRESS
          BX4    X5          CHECK FOR READ TO EOR
          SA2    X7+FLSW     GET FL OF CP/PCP
          LX4    59-38
          BX7    -X1*X2
          LX7    6           FL
          SA0    77B
          BX2    X7          SET MAXIMUM LWA+1 TRANSFER = FL
          PL     X4,UDP2     IF NOT READ TO EOR
          SX1    X5+B3       RELATIVE CM FWA TRANSFER + WORD COUNT
          LX5    -18
          SX1    X1-1        LWA OF TRANSFER
          SX6    X5          LWA SPECIFICATION
          LX5    18
          ZR     X6,UDP1     IF NO LWA SPECIFICATION
          NG     X6,/PROGRAM/HNG  IF INVALID LWA SPECIFICATION
          IX2    X7-X6
          NG     X2,/PROGRAM/HNG  IF LWA SPECIFICATION .GT. FL
          BX2    X6          SET MAXIMUM LWA+1 TRANSFER
 UDP1     IX1    X1-X2
          NG     X1,UDP2     IF TRANSFER DOES NOT EXCEED MAXIMUM
          BX6    -X1         TERMINATE TRANSFER AT MAXIMUM ADDRESS
          SB3    X6+B3
          SB3    B3-1
          SX6    B3+A0       RECALCULATE SECTOR COUNT
          AX6    6
          SB4    X6
 UDP2     SX6    X5+B3       RELATIVE FWA TRANSFER + WORD COUNT
          MX2    -18
          IX7    X7-X6
          BX6    -X2*X6
          NG     X7,/PROGRAM/HNG  IF TRANSFER BEYOND FL
          BX7    X2*X5       ADVANCE RELATIVE CM ADDRESS
          BX7    X7+X6
          BX5    -X2*X5
          SA2    A2          GET RA OF CONTROL POINT
          MX6    -RMSK
          LX2    -RSHF
          BX2    -X6*X2
          LX2    6
          IX5    X5+X2
          MX6    1
          BX1    -X1*X6      SET INSUFFICIENT FL FLAG
          SX2    B3+A0       COMPUTE SECTOR COUNT
          BX5    X5+X1
          AX2    6
          LX7    -24
          NG     X4,UDP3     IF READ TO EOR
          IX7    X7-X2       DECREMENT SECTOR COUNT
 UDP3     LX7    24
          SA4    A5+B1       GET *MB* PARAMETERS
          SA7    A5+         UPDATE *PIOM* *OR* PARAMETERS
          LX4    12
          MX6    -12
          IX7    X4+X2       ADVANCE TOTAL SECTORS TRANSFERRED
          BX7    -X6*X7      CLEAR POSSIBLE OVERFLOW
          BX4    X6*X4       CLEAR OLD SECTORS TRANSFERRED FIELD
          BX4    X4+X7
          LX4    -24
          IX7    X4+X2       ADVANCE CURRENT SECTOR
          MX2    -12
          LX4    -24
          BX6    -X2*X4      EST ORDINAL
          CX1    X6,EST      CONVERT EST ORDINAL TO OFFSET
          TA1    X1+EQDE,EST GET EST ENTRY
          BX1    -X2*X1      MST ADDRESS / 10B
          LX1    3
          SA1    X1+MDGL     GET SECTOR LIMIT
          BX6    -X2*X1
          BX1    -X2*X7
          IX6    X1-X6
          NG     X6,UDP4     IF NOT END OF TRACK
          BX6    -X2*X4      EQUIPMENT
          LX4    12-2
          CX1    X6,EST      CONVERT EST ORDINAL TO OFFSET
          TA1    X1+EQDE,EST READ EST ENTRY
          MX6    -9
          BX1    -X2*X1      MST ADDRESS / 10B
          BX4    -X6*X4      TRT WORD INDEX
          LX1    3
          AX7    12          CLEAR CURRENT SECTOR
          SA1    X1+TRLL     SET FWA OF TRT
          IX1    X1+X4
          MX6    -2
          SA1    X1+         READ TRT WORD
          BX6    -X6*X7      TRT BYTE INDEX
          SX4    12
          IX6    X6*X4
          SB6    X6
          LX1    B6
          PL     X1,/PROGRAM/HNG  IF NO NEXT TRACK
          LX1    12
          BX6    -X2*X1      GET NEXT TRACK
          BX7    X2*X7       CLEAR TRACK
          BX7    X7+X6       SET NEXT TRACK
          LX7    12
 UDP4     LX7    12          UPDATE *PIOM* *MB* PARAMETERS
          SA7    A4
          JP     B2          RETURN
 DIB      SPACE  4,15
**        DIB - DROP I/O BUFFERS.
*
*         ENTRY  (B5) = FIRST FREE TRACK POINTER.
*                (B6) = FWA TRT.
*                (A5) = PP *OR* ADDRESS.
*                (X3) = TRACK AND PRU INCREMENT.
*                (X4) = -3777B.
*                (X6) = NUMBER OF TRACKS AND PRU-S DROPPED.
*                (X7) = TRACK POINTER.
*
*         EXIT   ABOVE REGISTERS RESTORED AS ON ENTRY.
*                (B7) .NE. 0 TO INDICATE DEVICE.
*
*         USES   A - 1, 3, 6, 7.
*                B - 2, 5, 6.
*                X - 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  LBM.
 
 
 DIBA     CON    0           PSEUDO FNT (EQUIPMENT, TRACK, SECTOR)
 
 DIB1     SB5    B2          FIRST FREE TRACK POINTER
          SA3    SCRA        TRACK AND PRU INCREMENT
          SB6    B7          FWA TRT
          SA1    A3+B1       TRACK POINTER
          BX7    X1
          MX4    -11
          SA1    A1+B1       NUMBER OF TRACKS AND PRU-S DROPPED
          BX6    X1
          EQ     /PROGRAM/DTC5.1  RETURN TO DROP REMAINING TRACKS
 
 DIB      SA5    A5+         CHECK FOR PROGRAM MODE
          SB2    B5          SAVE (B5)
          LX5    59-58
          SA7    B1+SCRA     SAVE (W6)
          PL     X5,/PROGRAM/DTC5.1  IF NOT PROGRAM MODE
          SB7    B6          SAVE (B6)
          SA6    A7+B1       SAVE (X6)
          BX6    X3
          SX3    B1
          SA6    A7-B1       SAVE (X3)
          LX4    -12
          SA1    A5          BUILD PSEUDO FNT
          LX3    35-0
          LX7    2+24
          SX5    BMDB        DROP I/O BUFFERS
          LX1    12
          BX1    -X4*X1      EQUIPMENT
          SX2    DIBA-1      PSEUDO FNT ADDRESS
          LX5    -6
          BX7    X1+X7
          SB6    DIB1        RETURN ADDRESS FOR *LBM*
          BX7    X7+X3
          BX5    X5+X2
          SA7    X2+B1
*         EQ     LBM         CALL I/O BUFFER MANAGER
 LBM      SPACE  4,45
**        LBM - I/O BUFFER MANAGER.
*
*         ENTRY  (X5) = 6/OP, 6/PA, 24/0, 6/CP, 18/FNTA
*                       OP = OPERATION CODE.
*                            BMRD = READ BUFFER.
*                            BMWR = WRITE BUFFER.
*                            BMRW = REWRITE BUFFER.
*                            BMVI = VALIDATE AND INTERLOCK BUFFER.
*                            BMRG = RELEASE READ BUFFER AND GET NEXT.
*                            BMRB = RELEASE READ BUFFER.
*                            BMFL = FLUSH BUFFER.
*                            BMRF = RELEASE AND FLUSH WRITE BUFFER.
*                            BMFW = FLUSH ALL WRITE BUFFERS.
*                            BMTR = TERMINATE SHARED DEVICE READ
*                                   ACCESS.
*                            BMTW = TERMINATE SHARED DEVICE WRITE
*                                   ACCESS.
*                            BMDB = DROP ALL BUFFERS FOR FILE.
*                            BMDD = DROP ALL BUFFERS ON DEVICE.
*                            BMCR = COMPLETE SHARED DEVICE READ ACCESS
*                                   REQUEST.
*                            BMCW = COMPLETE SHARED DEVICE WRITE ACCESS
*                                   REQUEST.
*                       PA = OPERATION CODE DEPENDENT PARAMETER.
*                            FOR *BMRD* - BUFFER COUNT.
*                                     0 = USE DEFAULT BUFFER COUNT.
*                                     BUFFER COUNT IF .NE. 0.
*                            FOR *BMWR* - RECALL ALLOWED FLAG.
*                                     0 = RECALL ALLOWED.
*                                     1 = RECALL NOT ALLOWED.
*                            FOR *BMVI* - OPERATION CODE TO BE
*                                     EXECUTED IF BUFFER CANNOT BE
*                                     INTERLOCKED IN MONITOR MODE.
*                                     *BMRD* = INTERLOCK FOR READ.
*                                     *BMWR* = INTERLOCK FOR WRITE.
*                            FOR *BMRF* - WRITE OPERATION CODE TO BE
*                                     EXECUTED ON NEXT BUFFER AFTER
*                                     FLUSH OF CURRENT BUFFER.
*                                     0 = NO WRITE OPERATION.
*                                     *BMWR* = WRITE BUFFER.
*                                     *BMRW* = REWRITE BUFFER.
*                            FOR *BMFW* - RESTART 819 I/O FLAG.
*                                     0 = DO NOT RESTART 819 I/O.
*                                     RESTART 819 I/O IF .NE. 0.
*                            FOR *BMCR*, *BMCW* - STATUS CODE.
*                                     0 = NORMAL COMPLETION.
*                                     1 = *BRT* ENTRY EVICTED BY *MTE*.
*                                     2 = OTHER MACHINE CANNOT RELEASE
*                                         WRITE ACCESS.
*                       CP = CONTROL POINT NUMBER IF PSEUDO-PP CALL.
*                          = 0 IF PP CALL.
*                       FNTA = FNT OFFSET IF PSEUDO-PP CALL.
*                            = PSEUDO FNT ADDRESS IF PP CALL.
*                            = EST ORDINAL IF OP = *BMFW* OR *BMDD*.
*                            = 0 IF *BMFW* TO PROCESS ALL EQUIPMENTS.
*                (B6) = EXIT ADDRESS.
*
*         EXIT   (X6) = 5/ST, 43/0, 12/BI
*                       ST = STATUS.
*                            BIT 59 SET IF RECALL.
*                            BIT 58 SET IF BUFFER BUSY.
*                            BIT 57 SET IF I/O ERROR.
*                            BIT 56 SET IF INACCESSIBLE DEVICE.
*                            BIT 55 SET IF ADDRESS ERROR.
*                       BI = BUFFER INDEX.
*                (FNTA) = ABSOLUTE FNT ADDRESS.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 3, 6.
*
*         CALLS  DAB, FAW, FLB, RDB, REB, REN, RFB, RWB, WTB.
 
 
 LBM      SB3    SCRB        SET SUBROUTINE CALL STACK POINTER
          SX6    B6          SAVE RETURN ADDRESS
          MX1    -6          GET FUNCTION CODE
          SA6    RETA
          LX5    6
          BX7    -X1*X5      GET PRIMARY SUBFUNCTION
          LX5    6           GET BUFFER COUNT/SECONDARY SUBFUNCTION
          SA7    OPRC        SAVE OPERATION CODE
          SB6    X7
          BX6    -X1*X5
          LX5    -12
          SA6    OPAR        SAVE SUBFUNCTION PARAMETER
          MX1    -24
          SA6    BCNT
          BX6    -X1*X5
          SA6    RPRM
          SX7    X6          GET FNT RELATIVE ADDRESS
          AX6    18          GET CP NUMBER
          ZR     X6,LBM3     IF PP CALL
          BX1    X6          GET CP RA
          LX1    7
          SA1    X1+FLSW
          MX2    -RMSK
          LX1    -RSHF
          BX1    -X2*X1
          LX1    6
          IX7    X1-X7       FORM ADDRESS IN NEGATIVE FL
 LBM3     SA7    FNTA        SAVE FNT ADDRESS OR EST ORDINAL
          SX6    B6-BMFW
          ZR     X6,LBM6     IF FLUSHING ALL WRITE BUFFERS
          SX6    B6-BMDD
          ZR     X6,LBM6     IF DROPPING ALL BUFFERS
          SX1    B1          GET FNT WORD 1
          IX1    X7+X1
          ERX1   X1
          LX1    -12
          MX7    -LSLBS
          BX4    -X7*X1
          MX5    -12
          BX7    -X5*X1
          SA7    OLSC
          IX7    X7-X4       SET LOGICAL SECTOR TO START OF 4K BUFFER
          LX1    -12         GET LOGICAL TRACK
          SA7    LSEC
          BX7    -X5*X1
          LX1    -24         GET EST ORDINAL
          SA7    LTRK
          MX2    -9
          BX1    -X2*X1      EST ORDINAL
          CX2    X1,EST      CONVERT EST ORDINAL TO OFFSET
          SX6    B1
          TA2    X2+EQDE,EST READ EST ENTRY
          TX4    A5-1,-SP
          SA3    CHRV
          ZR     X4,LBM4     IF PSEUDO PP
          SA3    A5+1
 LBM4     SX7    1
          LX7    57-0
          BX7    X7*X2
          ZR     X7,LBM5     IF NOT SHARED DEVICE
          SX7    X1+         SET EST ORDINAL TO INDICATE SHARED DEVICE
 LBM5     SA7    SDEO
          BX7    -X5*X2      MST ADDRESS/10B
          LX6    5-0
          LX7    3
          BX6    X6*X3       GET *READSYS* BIT FROM *CHRV*
          BX2    X7
          LX6    55-5
          SA6    SFRF        SET/CLEAR SYSTEM FILE READ FLAG
          SA7    MSTA        SAVE MST ADDRESS
          SA2    X2+DILL
          MX7    -6
          BX7    -X7*X2
          SA7    AILE        ALGORITHM INDEX FOR *LDAM* EQUIPMENT
          SA1    FNTA        GET FNT WORD 2
          SX7    B1+B1
          IX1    X1+X7
          ERX1   X1
          BX7    -X5*X1      GET BUFFER INDEX
          SA7    BIDX
          SA3    A2+BDLL-DILL  UNPACK READ AHEAD PARAMETERS
          SX7    77B
          BX6    X7*X3
          AX3    6
          SA6    RBTH        READ BUFFER THRESHOLD
          BX6    X7*X3
          AX3    6
          SA6    DBAT        BUFFER ALLOCATION TRIGGER
          SA2    BCNT
          BX6    X7*X3
          SA6    DCNT
          NZ     X2,LBM6     IF BUFFER COUNT SUPPLIED
          SA6    BCNT
 LBM6     SA1    A5          REREAD OUTPUT REGISTER
          MX7    -6
          BX6    X6-X6
          BX7    -X7*X1      CHANNEL NUMBER, IF SELECTED BY CALLER
          SA7    CHAN
          SA6    FCBI
          SA6    NCHV
          SA6    DTSF        CLEAR DATA STREAMING FLAG
          PX7    X6          INITIALIZE BEST SYSTEM DEVICE ACTIVITY
          SA6    CHEA
          SA7    BSDA
          SA6    SYDI
          TNO    /BUFIO/LBS,BIOMMF
          JP     B6+LBMA     PROCESS FUNCTION
 
*         ENTER FUNCTION PROCESSOR.
*         (B3) = SUBROUTINE CALL STACK POINTER.
 
 LBMA     BSS    0
          EQ     RDB         READ BUFFER
          ERRNZ  BMRD
          EQ     WTB         WRITE BUFFER
          ERRNZ  BMWR-1
          EQ     RWB         REWRITE BUFFER
          ERRNZ  BMRW-2
          EQ     *           VERIFY/INTERLOCK MUST BE CALLED DIRECTLY
          ERRNZ  BMVI-3
          EQ     REB         RELEASE READ BUFFER AND GET NEXT BUFFER
          ERRNZ  BMRG-4
          EQ     REN         RELEASE READ BUFFER
          ERRNZ  BMRB-5
          EQ     FLB         FLUSH BUFFER
          ERRNZ  BMFL-6
          EQ     RFB         RELEASE AND FLUSH BUFFER
          ERRNZ  BMRF-7
          EQ     FAW         FLUSH ALL WRITE BUFFERS
          ERRNZ  BMFW-10B
          TEQ    (/BUFIO/RRA,BIOMMF,/PROGRAM/HNG)
          ERRNZ  BMTR-11B
          TEQ    (/BUFIO/RWA,BIOMMF,/PROGRAM/HNG)
          ERRNZ  BMTW-12B
          EQ     DAB         DROP ALL BUFFERS
          ERRNZ  BMDB-13B
          EQ     DBD         DROP ALL BUFFERS ON DEVICE
          ERRNZ  BMDD-14B
          TEQ    (/BUFIO/CRR,BIOMMF,/PROGRAM/HNG)
          ERRNZ  BMCR-15B
          TEQ    (/BUFIO/CWR,BIOMMF,/PROGRAM/HNG)
          ERRNZ  BMCW-16B
 
*         PROCESS NORMAL COMPLETION.
 
 LBMX     SA3    PUTO        COUNT BUFFER REQUEST
          SX7    B1+
          LX3    PUTLS
          SX6    B0+         CLEAR STATUS
+         TA1    X3+ACST,PUT **** PERFORM IN ONE WORD ****
          IX7    X1+X7       **** PERFORM IN ONE WORD ****
          SA7    A1          **** PERFORM IN ONE WORD ****
 
*         EXIT BUFFER MANAGER WITH STATUS FROM *X6*.
 
 LBMXS    SA2    FCBI
          ZR     X2,LBM9     IF NO BUFFER FOR RESPONSE
          BX1    X2
          LX2    CBTLS
          TA3    X2+HSLK,CBT GET DRIVER STATUS
          MX4    1
          BX2    X4*X3       GET I/O ERROR FLAG
          LX2    57-59
          BX6    X6+X2       MERGE STATUS AND ERROR FLAG
          SX4    5
          LX4    55-0
          BX2    X4*X6       I/O ERROR AND ADDRESS ERROR FLAGS
          TX5    A5-1,-SP
          ZR     X5,LBM7     IF PSEUDO PP
          SA3    NCHV
          SA4    A5+B1
          LX4    59-6
          NZ     X3,LBM7     IF NO *CHRV* DATA PRESENT
          NG     X4,LBM8     IF *1MV* RECALL AFTER FLUSH
 LBM7     NZ     X2,LBM9     IF I/O OR ADDRESS ERROR
 
 LBM8     BX6    X6+X1       MERGE STATUS AND BUFFER ORDINAL
 
 LBM9     SA1    RETA        GET RETURN ADDRESS
          SB6    X1
          BX7    X7-X7       CLEAR CONTROL BUFFER INTERLOCK
          SA7    INLB
          SA7    MSTA        CLEAR MST ADDRESS FOR *CDAM*
          SA5    A5+
          JP     B6          RETURN
 
 
 PARM     BSS    0           PARAMETER AREA
 AILE     BSS    1           ALGORITHM INDEX FOR *LDAM* EQUIPMENT
 BAFS     BSS    1           *BFMM* ABSOLUTE FST ADDRESS
 BCNT     BSS    1           BUFFER COUNT PARAMETER
 BDDC     BSS    1           *BFMM* DEVICE DESCRIPTORS AND BUFFER COUNT
 BFST     BSS    1           *BFMM* ORIGINAL FST ENTRY
 BIDX     BSS    1           BUFFER INDEX PARAMETER
 BSDA     BSS    1           BEST SYSTEM DEVICE ACTIVITY
 BSDI     BSS    1           INDEX OF BEST SYSTEM DEVICE
 CAFL     BSS    1           ROUTINE *CHA* - FORWARD LINK STORAGE
 CETS     BSS    LLCV+1      ROUTINE *CHA* - EVICT TABLE STORAGE
 CHAD     BSS    1           ROUTINE *CHA* - HASH ADDRESS STORAGE
 CHAN     BSS    1           CHANNEL SELECTED BY CALLER
 CHEA     BSS    1           CURRENT HASH ENTRY ADDRESS
 CLST     BSS    1           CURRENT LIST
 CSBS     BSS    1           ROUTINE *CHA* SCRATCH
 DBAT     BSS    2           DATA BUFFER ALLOCATION TRIGGER
 DCNT     EQU    DBAT+1      DEFAULT BUFFER COUNT
 DTSF     BSS    1           DATA STREAMING FLAG SET BY *REB*
 FBLB     BSS    1           FLUSH ALL WRITE BUFFERS LINK BYTE
 FCBI     BSS    1           FIRST CONTROL BUFFER (PROGRAM MODE)
 FCBM     BSS    1           FIRST CONTROL BUFFER (MONITOR MODE)
 FNTA     BSS    1           FNT ADDRESS
 HTA      BSS    1           HASH TABLE BASE ADDRESS
 LSEC     BSS    1           LOGICAL SECTOR
 LTRK     BSS    1           LOGICAL TRACK
 MSTA     BSS    1           MST ADDRESS
 NCHV     BSS    1           *CHRV* PRESENT FLAG
 OLSC     BSS    1           ORIGINAL LOGICAL SECTOR
 OPAR     BSS    1           OPERATION CODE PARAMETER
 OPRC     BSS    1           BUFFER MANAGER OPERATION CODE
 PUTO     BSS    1           24/SUSL, 18/RLSN, 18/PUTO
*                              SUSL = SINGLE UNIT SECTOR LIMIT
*                              RLSN = RELATIVE SECTOR NUMBER IN UNIT
*                              PUTO = *PUT* ORDINAL
 RBCT     BSS    2           READ BUFFER COUNT
 RBTH     EQU    RBCT+1      READ BUFFER THRESHOLD
 RETA     BSS    1           RETURN ADDRESS (USED IN ROUTINE *LBM*)
 RPRM     BSS    1           RECALL PARAMETER
 SDEO     BSS    1           EST ORDINAL IF SHARED DEVICE
 SDUR     CON    0           SHARED DEVICE UNABLE TO RELEASE ACCESS
 SDWR     CON    0           SHARED DEVICE WRITE ACCESS REQUESTED
 SFRF     BSS    1           SYSTEM FILE READ FLAG
 SYDI     BSS    1           SYSTEM DEVICE TABLE INDEX
 PARML    EQU    *-PARM      PARAMETER BLOCK LENGTH
 
 INLB     CON    0           CONTROL BUFFER INTERLOCK CELL
          SPACE  4,10
**        SCRATCH AREA.
 
 
 SCRA     BSS    14B         *DTKM* REGISTER SAVE AREA
 SCRB     BSS    14B         *LBM* PROGRAM MODE REGISTER AREA
          TITLE  FUNCTION PROCESSORS.
 CDA      SPACE  4,15
**        CDA - CHECK DEVICE ACCESSIBILITY.
*
*         ENTRY  (A5) = PP OUTPUT REGISTER ADDRESS.
*                (B5) = EXIT ADDRESS.
*                (X5) = -7777B.
*                (MSTA) = MST ADDRESS.
*
*         EXIT   (X6) = 0 IF DEVICE MAY BE ACCESSED.
*                     = 3/0, 1/1, 56/0  IF DEVICE MUST NOT BE ACCESSED.
*                TO *LBMXS* IF DEVICE IS INACCESSIBLE.
*
*         USES   A - 2, 3, 4.
*                X - 2, 3, 4, 6.
 
 
 
 CDA      BSS    0           ENTRY
          SA4    A5+1
          TX3    A5-1,-SP
          NZ     X3,CDA0     IF NOT PSEUDO PP
          SA4    CHRV
 CDA0     SA3    MSTA
          BX6    X6-X6
          LX4    59-5
          SA2    X3+DALL     GET DEVICE STATUS
          SA3    INWL
          LX2    59-55
          LX3    59-15
          PL     X2,CDA2     IF DEVICE IS ACCESSIBLE
          NG     X4,CDA2     IF SYSTEM FILE READ
          NG     X3,CDA2     IF DEADSTART SEQUENCING NOT COMPLETE
          SX3    X2+B1
          LX4    59-1-59+5
          ERRNZ  EPAD-2      CODE DEPENDS ON VALUE
          NG     X4,CDA2     IF CALLER MAY ACCESS DOWN DEVICE
          LX3    59-2
          LX4    59-2-59+1
          NG     X3,CDA1     IF DEVICE IS DOWN
          NG     X4,CDA2     IF CALLER MAY ACCESS OFF/SUSPECT DEVICE
          TX3    A5-1,-FP
          LX3    PPXES-PPCES
          TA3    X3+ACPP,FPX
          SX3    X3          CONTROL POINT ADDRESS
          SA3    X3+JCIW
          SA4    A3+SEPW-JCIW
          LX3    -24
          BX3    -X5*X3
          SX3    X3-LSSI-1
          PL     X3,CDA2     IF SUBSYSTEM
          SA3    A3+TFSW-JCIW
          LX4    59-56
          LX3    -48
          NG     X4,CDA2     IF *UTL=* ENTRY POINT IS PRESENT
          BX3    -X5*X3
          CX4    X3,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA4    X4+SCHE,EJT
          LX2    59-57-59+55
          LX4    59-34
          ERRNZ  UCTM-2      CODE DEPENDS ON VALUE
          NG     X4,CDA2     IF UNCONDITIONAL JOB TERMINATION IS SET
          SA3    OPRC
          NG     X2,CDA1     IF DEVICE IS OFF
          SX2    X3-BMWR
          ZR     X2,SBB      IF WRITE OPERATION ON SUSPECT DEVICE
          SX2    X3-BMRW
          ZR     X2,SBB      IF REWRITE OPERATION ON SUSPECT DEVICE
          SX2    X3-BMFO
          PL     X2,CDA2     IF OPERATION ALLOWED ON SUSPECT DEVICE
 CDA1     SX6    B1          SET *INACCESSIBLE* STATUS
          LX6    56
          EQ     LBMXS       EXIT
 
 CDA2     JP     B5          EXIT
 DAB      SPACE  4,15
**        DAB - DROP ALL BUFFERS.
*
*         ENTRY  INPUT REQUEST DECODED BY LBM MAIN ROUTINE.
*
*         EXIT   CONTROL GIVEN TO LBMX.
*
*         USES   A - 2, 3, 6, 7.
*                B - 6.
*                X - 0, 1, 2, 3, 6, 7.
*
*         CALLS  CHA, DCC, DCH, LCC.
 
 
 DAB      BSS    0           ENTRY
          SX7    B1          INDICATE PP HAS NO *CHRV* DATA
          SA7    NCHV
          SX7    -B1         SET LOCATE HASH TABLE ENTRY
          SB6    DAB1        RETURN ADDRESS FOR *CHA*
          EQ     CHA         CALCULATE HASH ADDRESS
 
 DAB1     ZR     X1,LBMX     IF HASH TABLE BUSY
          SA2    X1          GET HASH ENTRY
          MX7    -12
 DAB2     ZR     X2,LBMX     IF NO ENTRIES TO PROCESS
          BX6    -X7*X2
          BX0    -X7*X2
          SA6    INLB        SET *CBT* INTERLOCK
          LX6    CBTLS
          MX7    -48
          TA2    X6+IOLK,CBT GET I/O INTERLOCK FROM *CBT*
          SA3    A2+B1       GET HASH LINK WORD FROM *CBT*
          ERRNZ  HSLK-IOLK-1 CODE DEPENDS ON VALUE
          BX6    X6-X6
          NG     X2,DAB6     IF I/O INTERLOCK SET
          BX6    X3          SAVE HASH LINK WORD
          SA3    A3+B1
          ERRNZ  LSLK-HSLK-1 CODE DEPENDS ON VALUE
          SA6    DABA
          BX6    -X7*X2      CLEAR I/O FLAGS
          BX7    -X7*X3      CLEAR ACCESS COUNT
          SA6    A2
          SA7    A3
          SB6    DAB3        RETURN ADDRESS FOR *DCH*
          EQ     DCH         DELINK *CBT* FROM HASH LINK
 
 DAB3     BX1    X0
          SX2    B1
          LX1    CBTLS
          LX2    57
          TA1    X1+IOLK,CBT
          BX7    -X2*X1      CLEAR WRITE FLAG
          SA7    A1
          SB6    DAB4        RETURN ADDRESS FOR *DCC*
          EQ     DCC         DELINK *CBT* FROM LIST LINK
 
 DAB4     SB6    DAB5        RETURN ADDRESS FOR *LCC*
          TX1    EMTB
          EQ     LCC         LINK *CBT* TO EMPTY LIST
 
 DAB5     SA3    DABA        FIND NEXT *CBT* ON HASH LINK
          BX6    X6-X6
 DAB6     AX3    24
          MX7    -12
          SA6    INLB        CLEAR *CBT* INTERLOCK
          BX2    -X7*X3      NEXT *CBT* ORDINAL
          EQ     DAB2        LOOP FOR NEXT *CBT*
 
 
 DABA     BSS    1           CURRENT *HSLK* WORD
 DBD      SPACE  4,15
**        DBD - DROP ALL BUFFERS ON SPECIFIED DEVICE.
*
*         ENTRY  INPUT REQUEST DECODED BY LBM MAIN ROUTINE.
*
*         EXIT   TO *LBMX* IF ALL BUFFERS DROPPED.
*                TO *SBB* IF NOT ALL BUFFERS DROPPED.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6.
*                B - 4, 5, 6.
*
*         CALLS  DCC, DCH, LCC.
 
 
 DBD      BSS    0           ENTRY
 
*         SET FIRST PUT ORDINAL.
 
          SA1    FNTA        GET EST ORDINAL
          MX0    -12
          CX2    X1,EST
          TA1    X2+EQDE,EST
          BX1    -X0*X1
          LX1    3           MST ADDRESS
          SA3    A1+EQAE-EQDE
          MX2    -4
          LX3    -18
          BX3    -X2*X3      PARTITION NUMBER
          SX2    HATLE
          IX6    X2*X3       HASH TABLE PARTITION OFFSET
          SA6    DBDC
          SA1    X1+DILL
          SB4    LBMX        SET EXIT ADDRESS FOR ALL BUFFERS DROPPPED
          LX1    -24
          BX6    -X0*X1
          SA6    DBDA        SET FIRST PUT ORDINAL
 
*         SET HASH TABLE ADDRESS AND SAVE NEXT PUT ORDINAL.
 
 DBD1     SA1    DBDA        GET PUT ORDINAL
          ZR     X1,RB4      IF ALL UNITS PROCESSED, EXIT
          LX1    PUTLS
          TA2    X1+HSCT,PUT
          MX0    -12
          BX6    -X0*X2
          SA6    A1          SAVE NEXT PUT ORDINAL
          MX0    -18
          LX2    -24
          BX6    -X0*X2
          SA3    DBDC        GET HASH TABLE PARTITION OFFSET
          SB5    -B1         INITIALIZE HASH TABLE INDEX
          IX6    X6+X3       ADD HASH TABLE PARTITION OFFSET
          SA6    DBDB        SAVE HASH TABLE ADDRESS
 
*         GET NEXT HASH TABLE ENTRY.
 
 DBD2     SA1    DBDB        GET HASH TABLE ADDRESS
          SB5    B5+1        ADVANCE HASH TABLE INDEX
          SX2    B5-HATLE
          ZR     X2,DBD1     IF END OF HASH TABLE
          SA1    X1+B5       GET HASH ENTRY
          MX7    -12
          BX7    -X7*X1      SET FIRST BUFFER ORDINAL
 
*         DROP INACTIVE BUFFERS.
 
 DBD3     SA7    INLB        SET BUFFER INTERLOCK
          BX0    X7          NEXT BUFFER ORDINAL
          LX7    CBTLS       SET CBT OFFSET
          ZR     X0,DBD2     IF END OF BUFFERS IN ENTRY
          TA2    X7+IOLK,CBT GET I/O INTERLOCK AND WRITE FLAG
          TA3    X7+HSLK,CBT GET HASH LINK
          TA4    X7+LSLK,CBT GET ACTIVITY COUNT
          SX1    5000B
          MX6    12
          LX1    48
          MX7    -12
          BX2    X1*X2       I/O INTERLOCK AND WRITE FLAG
          LX3    -24
          BX4    X6*X4       ACTIVITY COUNT
          BX7    -X7*X3      SET NEXT BUFFER ORDINAL
          BX6    X2+X4
          ZR     X6,DBD4     IF NO ACTIVITY REMAINS
          SB4    SBB         SET BUFFER BUSY EXIT
          EQ     DBD3        CHECK NEXT BUFFER
 
 DBD4     SB6    DBD5        SET *DCH* RETURN ADDRESS
          EQ     DCH         DELINK BUFFER FROM HASH TABLE
 
 DBD5     SB6    DBD6        SET *DCC* RETURN ADDRESS
          EQ     DCC         DELINK BUFFER FROM CURRENT LIST
 
 DBD6     SB6    DBD3        SET *LCC* RETURN ADDRESS
          TX1    EMTB
          EQ     LCC         LINK BUFFER TO EMPTY LIST
 
 
 DBDA     BSS    1           NEXT PUT ORDINAL
 DBDB     BSS    1           HASH TABLE ADDRESS
 DBDC     BSS    1           HASH TABLE PARTITION OFFSET
 FAW      SPACE  4,15
**        FAW - FLUSH ALL WRITE BUFFERS.
*
*         ENTRY  INPUT REQUEST DECODED BY LBM MAIN ROUTINE.
*
*         EXIT   CONTROL GIVEN TO LBMX.
*
*         USES   A - 1, 2, 3, 6.
*                B - 5, 6.
*                X - 0, 1, 2, 3, 5, 6.
*
*         CALLS  CDA, DCC, LCC.
 
 
 FAW      BSS    0           ENTRY
          TX6    DWTB        SET DATA WRITTEN AS CURRENT LIST
          SA6    CLST
          TA1    WRTB        GET FIRST WRITE BUFFER
          SX6    X1+         SAVE LINK BYTE
          SA6    FBLB
 FAW1     SA1    FBLB        READ NEXT CONTROL BUFFER
          ZR     X1,FAW5     IF ALL BUFFERS FLUSHED
          SB6    X1
          SX6    X1          SET CONTROL BUFFER INTERLOCK
          MX5    -12
          LX1    CBTLS
          SA6    INLB
          TA1    X1+FSTC,CBT EST ORDINAL
          LX1    12
          SA2    A1+LSLK-FSTC  GET LINK TO NEXT BUFFER
          BX1    -X5*X1      EST ORDINAL
          BX0    X2
          CX3    X1,EST      CONVERT EST ORDINAL TO OFFSET
          TA3    X3+EQDE,EST
          SB5    FAW1.1      SET *CDA* EXIT ADDRESS
          BX6    -X5*X3
          LX6    3
          SA6    MSTA        STORE MST ADDRESS FOR *CDA*
          EQ     CDA         CHECK DEVICE ACCESSIBILITY
 
 FAW1.1   SA3    FNTA
          MX2    12
          BX2    X2*X0
          LX0    -24
          BX1    X1-X3
          BX6    -X5*X0      NEXT BUFFER ORDINAL
          SX0    B6
          SA6    FBLB
          NZ     X2,FAW1     IF BUFFER CURRENTLY BEING ACCESSED
          ZR     X3,FAW2     IF FLUSHING ALL BUFFERS
          NZ     X1,FAW1     IF NOT SELECTED EQUIPMENT
 FAW2     SB6    FAW3        RETURN ADDRESS FOR ROUTINE *DCC*
          EQ     DCC         DELINK CONTROL BUFFER FROM CONTROL BUFFER
 
 FAW3     TX1    DWTB        LINK BUFFER TO DATA WRITTEN LIST
          SB6    FAW4
          EQ     LCC         LINK CONTROL BUFFER
 
 FAW4     BX6    X0          INITIATE I/O ON BUFFER
          TA6    IORQ
          XJ
 
          EQ     FAW1        PROCESS NEXT WRITE BUFFER
 
 FAW5     SA1    OPAR
          ZR     X1,LBMX     IF BUFFER COUNT = 0
          TNO    /BUFIO/LBMX,IHPFMD  EXIT IF NOT 819
          SX6    3           RESTART 819 I/O
          LX6    36
          TA6    IORQ
          XJ
 
          EQ     LBMX        RETURN
 FLB      SPACE  4,15
**        FLB - FLUSH BUFFER TO DISK.
*
*         ENTRY  INPUT REQUEST DECODED BY LBM MAIN ROUTINE.
*
*         EXIT   CONTROL GIVEN TO LBMX.
*                TO /PROGRAM/ HNG IF CONTROL BUFFER NOT FOUND.
*
*                X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 6, 7.
*                B - 6.
*
*         CALLS  DCC, LCC, SRR.
 
 
 FLB      BSS    0           ENTRY
          SA2    BIDX
          ZR     X2,LBMX     IF NO CONTROL BUFFER
          BX6    X2          INTERLOCK BUFFER
          LX2    CBTLS
          SA6    INLB
          TA3    X2+LSLK,CBT CHECK ACTIVITY COUNT
          MX4    12
          BX3    X4*X3
          NZ     X3,FLB7     IF BUFFER INTERLOCKED
 
*         ENTRY FROM *RFB*.
*         BUFFER IS WRITE INTERLOCKED IF ENTERED FROM *RFB*.
 
 FLB1     TA3    X2+IOLK,CBT CHECK I/O ACTIVE
          NG     X3,FLB6     IF INTERLOCK SET
          LX3    59-57
          PL     X3,FLB6     IF NOT WRITE DATA
          BX0    X6
          TX2    A5-1,-SP
          SA3    A5+1
          NZ     X2,FLB1.1   IF NOT PSEUDO PP
          SA3    CHRV
 FLB1.1   TA6    IORQ
          LX3    59-4
          PL     X3,FLB2     IF NOT DEVICE VERIFICATION
          SB6    FLB2        SET *SRC* RETURN ADDRESS
          EQ     SRC         SET RECALL CONTROL
 
 FLB2     XJ                 INITIATE I/O
 
          SB6    FLB4        RETURN ADDRESS FOR ROUTINE *DCC*
          EQ     DCC         DELINK CONTROL BUFFER FROM CONTROL BUFFER
 
 FLB4     SB6    FLB5        LINK TO DATA WRITTEN LIST
          TX1    DWTB
          EQ     LCC         LINK CONTROL BUFFER
 
 FLB5     BX1    X0          GET ACCESS COUNT WORD
          LX1    CBTLS
          TA2    X1+LSLK,CBT
          MX3    12          CLEAR WRITE INTERLOCK
          BX6    -X3*X2
          SA6    A2+
 FLB6     SA1    OPAR
          ZR     X1,FLB7     IF NO WRITE REQUEST
          SX1    X1-BMWR
          SX7    B0          CLEAR PARAMETER
          SA7    A1
          ZR     X1,WTB      IF WRITE
          EQ     RWB         REWRITE
 
*         THE BUFFER INDEX IS RETURNED HERE FOR THOSE ROUTINES WHICH
*         NEED TO CHECK IF THE BUFFER FLUSH HAS COMPLETED.
 
 FLB7     TX2    A5-1,-SP
          SA1    BIDX
          SA3    A5+B1
          BX6    X1
          SA6    FCBI
          ZR     X2,LBMX     IF PSEUDO PP
          LX3    59-4
          SX6    B1
          PL     X3,LBMX     IF NOT DEVICE VERIFICATION OPERATION
          LX6    6-0
          LX3    4-59
          BX6    X6+X3       SET BUFFER FLUSH FLAG
          SA6    A3
          EQ     SRR         SET RECALL RESPONSE
 INB      SPACE  4,30
**        INB - INTERLOCK BUFFER.
*
*         MONITOR MODE ONLY.
*
*         NOTE - FOR PERFORMANCE REASONS, *INB* IS CALLED DIRECTLY BY
*                *BFMM* AND *PIOM* TO AVOID UNNECCESSARY BUFFER MANAGER
*                START UP AND SHUT DOWN OVERHEAD.
*
*         ENTRY  (X2) = SUBFUNCTION.
*                (X6) = *FST*.
*                (X7) = BUFFER INDEX TO VALIDATE.
*                (B6) = EXIT ADDRESS.
*
*         EXIT   (X6) = 1/0, 1/B, 1/E, 1/I, 44/0, 12/BI
*                       B = 1 IF BUFFER BUSY.
*                       E = 1 IF I/O ERROR.
*                       I = 1 IF INACCESSIBLE SHARED DEVICE.
*                       BI = BUFFER ORDINAL.
*                          = 0 IF BUFFER NOT FOUND OR CANNOT BE
*                            INTERLOCKED.
*                (B6) = RETURN ADDRESS.
*                (FCBM) = ORDINAL OF BUFFER WITH ERROR.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 3.
*                X - ALL.
 
 
 INB      BSS    0           ENTRY
          BX1    X7
          BX7    X7-X7       CLEAR BUFFER ORDINAL
          SA7    FCBM
          BX7    X1
          LX1    CBTLS
          TA4    X1+HSLK,CBT
          SA3    INBA
          SB3    X2          SUBFUNCTION
          SX0    B1
          SA2    A4-B1
          ERRNZ  HSLK-IOLK-1 CODE DEPENDS ON VALUE
          SA1    A2-B1
          ERRNZ  IOLK-FSTC-1 CODE DEPENDS ON VALUE
          BX1    X6-X1
          BX1    X3*X1
          SA3    INLB
          NZ     X1,INB8     IF FST/CBT MISMATCH
          BX3    X3-X7
          BX6    X7          SAVE BUFFER ORDINAL FOR REPLY
          ZR     X3,INB7     IF INTERLOCK SET
          SA3    A4-HSLK+LSLK
          BX5    X2
          LX2    59-57
          PL     X4,INB1     IF NO I/O ERROR
          PL     X2,INB9     IF NO WRITE DATA IN BUFFER
 INB1     NZ     B3,INB4     IF WRITE/REWRITE
          ERRNZ  BMRD        CODE DEPENDS ON VALUE
          SX1    B1+
          NG     X3,INB7     IF WRITE INTERLOCK IS SET
          LX1    48
          IX7    X3+X1       INCREMENT ACCESS COUNT
          NG     X5,INB3     IF I/O ACTIVE
          NG     X2,INB5     IF BUFFER CONTAINS WRITE DATA
 INB2     SA7    A3
          EQ     INB6        COUNT STATUS AND RETURN
 
 INB3     PL     X2,INB7     IF READ BUFFER BEING FILLED
          EQ     INB2        ALLOW READ OF WRITE DATA
 
 INB4     MX1    12
          BX1    X1*X3       GET ACCESS COUNT
          NG     X5,INB7     IF I/O INTERLOCK SET
          NZ     X1,INB7     IF ACCESS COUNT NOT ZERO
          PL     X2,INB4.2   IF WRITE DATA ACCESS FLAG CLEAR
 INB4.1   MX1    1
          BX7    X3+X1       SET WRITE INTERLOCK
          SA7    A3+
          EQ     INB6        COUNT STATUS AND RETURN
 
 INB4.2   TX1    A5-1,-SP
          ZR     X1,INB5     IF PSEUDO PP CALL
          SA1    A5+B1
          LX1    59-6
          NG     X1,INB4.1   IF *1MV* RECALL AFTER FLUSH
 INB5     SX6    B0+         SET REPLY STATUS
          SX0    B0+         DON-T COUNT ACCESS ATTEMPT
 INB6     MX1    -12
          BX3    -X1*X4
          LX3    PUTLS
          TA1    X3+INST,PUT
          IX7    X1+X0
          SA7    A1          UPDATE BUFFER VALIDATE STATISTICS
 INB6.1   SA5    A5          RESTORE PP OUTPUT REGISTER
          JP     B6          RETURN
 
 INB7     LX0    58-0
          BX6    X6+X0       SET BUFFER BUSY
          EQ     INB6.1      EXIT
 
 INB8     LX0    36          COUNT REJECT
          BX6    X6-X6
          EQ     INB6        EXIT WITH BUFFER NOT FOUND
 
 INB9     NG     X5,INB7     IF I/O INTERLOCK IS SET
          LX0    57-0
          BX6    X0          SET I/O ERROR STATUS
          SA7    FCBM        SAVE BUFFER ORDINAL FOR CALLER
          EQ     INB6.1      EXIT
 
 
 INBA     DATA   07770000777777400000B  *FST* COMPARISON MASK
 RDB      SPACE  4,35
**        RDB - INTERLOCK BUFFER IN READ MODE OR INITIATE READ.
*
*         ENTRY  (BCNT) = COUNT OF BUFFERS TO ALLOCATE IF REQUESTED
*                         BUFFER IS READ FROM DISK.
*
*         EXIT   TO *LBMX* IF BUFFER FOUND AND INTERLOCKED.
*                TO *SBB* IF BUFFER FOUND BUT CANNOT BE INTERLOCKED,
*                  DATA READ IN PROGRESS AND RECALL CONTROL ALREADY SET
*                  ON BUFFER, OR BUFFER CANNOT BE ALLOCATED.
*                TO *SRR* IF READ INITIATED OR IF DATA READ ALREADY IN
*                  PROGRESS AND RECALL CONTROL IS NOT ALREADY SET ON
*                  THE BUFFER.
*                READ-AHEAD ON ADDITIONAL CONSECUTIVE BUFFERS INITIATED
*                  AS NEEDED IF TO RECALL ON READ OF REQUESTED BUFFER.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 6.
*                X - ALL.
*
*         CALLS  ANB, CSD, CHA, DCC, LCC, SBB, SNS, SRC, SRR.
*
*         IF THE BUFFER INDICATED BY *LTRK* AND *LSEC* IS FOUND AND CAN
*         BE INTERLOCKED IN READ MODE, NORMAL STATUS WILL BE RETURNED.
*         BUFFER BUSY STATUS WILL BE RETURNED IF THE BUFFER IS FOUND
*         BUT INTERLOCKED IN WRITE MODE, IF A READ IS IN PROGRESS AND
*         RECALL CONTROL IS ALREADY SET, OR IF THE BUFFER IS NOT FOUND
*         AND CANNOT BE ALLOCATED.  IN NONE OF THESE CASES WILL AN
*         ATTEMPT BE MADE TO ALLOCATE ADDITIONAL BUFFERS.  IF A READ
*         BUFFER IS ALLOCATED OR IF A READ IS ALREADY IN PROGRESS AND
*         RECALL CONTROL IS NOT ALREADY SET ON THE BUFFER, RECALL
*         CONTROL WILL BE SET AND RECALL STATUS WILL RETURNED. ALSO,
*         ADDITIONAL CONSECUTIVE BUFFERS WILL BE ALLOCATED, IF
*         POSSIBLE, ACCORDING TO THE VALUE OF *BCNT*.
 
 
 RDB      BSS    0           ENTRY
          SX7    B0          SET BUFFER NOT ALLOCATED
          SA3    BCNT        SET BUFFER COUNT TO ALLOCATE
          BX6    -X3
          SA6    RBCT
          TX6    DRDB        SET READ AS CURRENT LIST
          SA6    CLST
 
*         FIND NEXT BUFFER.
 
 RDB2     SB6    RDB3        *CHA* RETURN ADDRESS
          TEQ    (/BUFIO/CSD,BIOMMF,/BUFIO/CHA)  CHECK BUFFER STATUS
 
 RDB3     ZR     X2,RDB14    IF FIRST ACCESS TO HASH ENTRY
          NG     X2,RDB11    IF BUFFER CANNOT BE ALLOCATED
          ZR     X0,RDB14    IF BUFFER NOT FOUND
          ZR     X7,RDB4     IF NO BUFFERS ALLOCATED
          SB6    RDB19
          EQ     CAT         CHECK ALLOCATION TRIGGER
 
 RDB4     SX6    X0+         SAVE BUFFER ORDINAL FOR RESPONSE
          SA6    FCBI
          SA6    INLB        SET CONTROL BUFFER INTERLOCK
          LX6    CBTLS
          TA2    X6+IOLK,CBT READ ACCESS FLAGS WORD
          TA3    X6+LSLK,CBT READ ACCESS WORD COUNT
          NG     X2,RDB6     IF I/O INTERLOCK SET
          LX2    59-57
          BX6    X0
          NG     X3,SBB      IF BUFFER INTERLOCKED IN WRITE MODE
          PL     X2,RDB8     IF NO WRITE DATA PRESENT
          TA6    IORQ        FLUSH WRITE DATA
          XJ
 
          EQ     RDB8        DELINK BUFFER
 
 RDB6     LX2    59-57
          PL     X2,RDB10    IF READ IN PROGRESS
 RDB8     SA2    A3-LSLK+HSLK
          NG     X2,LBMX     IF I/O ERROR
          SX5    B1
          LX5    48
          SB6    RDB9        DELINK BUFFER FROM CONTROL BUFFER CHAIN
          IX6    X3+X5
          SA6    A3
          EQ     DCC         DELINK CONTROL BUFFER FROM CONTROL BUFFER
 
 RDB9     TX1    DRDB        LINK BUFFER TO READ CHAIN
          SA2    BCNT        CHECK BUFFER COUNT
          SX4    B1          SET READ TRIGGER
          BX3    X0
          SX2    X2-1
          LX4    58-0
          ZR     X2,RDB9.1   IF REQUEST WAS FOR ONE BUFFER
          LX3    CBTLS
+         TA2    X3+IOLK,CBT **** PERFORM IN ONE WORD ****
          BX6    X2+X4       **** PERFORM IN ONE WORD ****
          SA6    A2          **** PERFORM IN ONE WORD ****
 RDB9.1   SB6    LBMX        SET EXIT ADDRESS
          EQ     LCC         LINK CONTROL BUFFER
 
 RDB10    BX5    X0          CHECK RECALL CONTROL
          LX5    CBTLS
          TA2    X5+LSLK,CBT
          MX3    -24
          BX4    -X3*X2
          NZ     X4,SBB      IF RECALL CONTROL SET
          SA1    RPRM        GET RECALL PARAMETER
          SX6    2           SET UP *IOC* CALL
          LX6    24
          BX6    X6+X1
          LX6    12
          BX6    X6+X0
          TA6    IORQ
          XJ                 SET RECALL CONTROL
 
          NZ     X6,SRR      IF FUNCTION WAS ACCEPTED
          BX2    X0
          LX2    CBTLS
          TA3    X2+LSLK,CBT READ ACCESS COUNT
          EQ     RDB8        PROCESS RESPONSE
 
 RDB11    NZ     X7,SRR      IF BUFFERS ALLOCATED
          EQ     SBB         SET BUFFER BUSY RESPONSE
 
*         ALLOCATE ADDITIONAL BUFFERS.
 
 RDB12    SB6    RDB13       RETURN ADDRESS FOR ROUTINE *SNS*
          EQ     SNS         SET NEXT SECTOR
 
 RDB13    NZ     X0,SRR      IF EOI
          EQ     RDB2        ALLOCATE NEXT BUFFER
 
 RDB14    SA1    SFRF        GET SYSTEM FILE READ FLAG
*         SB0    0           (ONE SYSTEM DEVICE)
          NZ     X1,RDB20    IF SYSTEM FILE READ
*         SB0    0           (ONE SYSTEM DEVICE)
          SA1    ANBA        GET DATA WRITTEN THRESHOLD
          SX6    X1-1        UPDATE THRESHOLD FOR WRITE
          SX1    X6-DWLT
          NG     X1,RDB15    IF AT LOWER LIMIT
          SA6    A1+         SAVE NEW THRESHOLD
 RDB15    SB6    RDB16       RETURN ADDRESS FOR ROUTINE *ANB*
          EQ     ANB         ALLOCATE NEXT BUFFER
 
 RDB16    ZR     X0,RDB11    IF BUFFER NOT AVAILABLE
          NZ     X7,RDB17    IF NOT FIRST BUFFER ALLOCATED
          SX7    X0+         SAVE ORDINAL OF FIRST BUFFER ALLOCATED
          SA7    FCBI
          SB6    RDB17       RETURN ADDRESS FOR ROUTINE *SRC*
          EQ     SRC         SET RECALL CONTROL
 
 RDB17    SB6    RDB18       CHECK ALLOCATION TRIGGER
          SA2    DTSF        CHECK FOR DATA STREAMING
          SX6    B1+
          ZR     X2,CAT      IF NOT STREAMING DATA
          SA6    DBAT
          EQ     CAT         CHECK ALLOCATION TRIGGER
 
 RDB18    TA7    IORQ        INITIATE I/O
          XJ
 
 RDB19    NZ     X6,RDB12    IF MORE BUFFERS TO ALLOCATE
          EQ     SRR         SET RECALL REPLY
 
*         IF A JOB IS READING THE SYSTEM FILE, AND THE DATA IS
*         NOT ALREADY RESIDENT IN ESM/LCM, THE OTHER SYSTEM DEVICES
*         ARE SEARCHED TO SEE IF THE DATA HAPPENS TO ALREADY BE IN
*         ESM/LCM, BUT READ FROM A DIFFERENT UNIT (THIS METHOD
*         DEPENDS ON THE FACT THAT EVERY COPY OF THE SYSTEM FILE
*         HAS IDENTICAL LOGICAL AND PHYSICAL ADDRESSES FOR EVERY
*         RECORD).  IF THE DATA IS FOUND TO NOT RESIDE IN ESM/LCM
*         IN ANY FORM, THE SYSTEM DEVICE WITH THE LEAST ACTIVITY
*         IS USED TO READ THE DATA.
 
 RDB20    SA1    SYDI        SYSTEM DEVICE INDEX
          BX5    X7          SAVE (X7)
          SX6    X1+B1       INCREMENT INDEX
          SA3    RDBB-1+X6
          ZR     X3,RDB23    IF END OF TABLE
          SA6    A1
          SA1    X3          *DALL* WORD OF THIS DEVICE
          SA2    BSDA        *DALL* OF PREVIOUS BEST SYSTEM DEVICE
          IX2    X1-X2
          BX7    X1
          PL     X2,RDB21    IF NO ACTIVITY IMPROVEMENT
          SA6    BSDI        SET NEW BEST SYSTEM DEVICE INDEX
          SA7    A2+         SET NEW BEST ACTIVITY
 RDB21    SA1    FNTA        FNT ADDRESS
          R=     X7,FSTL
          MX4    -48
          TX0    SP
          SA2    RDBA-1+X6   EST ORDINAL
          IX0    X1-X0
          LX2    48
          IX7    X1+X7
          ERX1   X7          READ FST
          BX6    -X4*X1      CLEAR OLD EST ORDINAL
          BX6    X6+X2       ADD NEW EST ORDINAL
          LX4    -12
          EWX6   X7          UPDATE FST
          PL     X0,RDB22    IF FNT IN JOB NFL
          SA1    X7-2        READ MB+0
          LX2    -12
          BX6    -X4*X1      CLEAR OLD EST ORDINAL
          BX6    X6+X2       ADD NEW EST ORDINAL
          SA6    A1
 RDB22    SX6    X3-DALL     SAVE MST ADDRESS
          SA6    MSTA
          BX7    X5          RESTORE (X7)
          EQ     RDB2        CHECK NEXT SYSTEM DEVICE
 
 RDB23    SA1    BSDI        BEST SYSTEM DEVICE INDEX
          SA3    RDBB-1+X1   MST ADDRESS (*DALL* ADDRESS)
          BX7    X7-X7
          BX6    X1
          SA7    SFRF        CLEAR SYSTEM FILE READ FLAG
          EQ     RDB21       READ SYSTEM FILE FROM SELECTED DEVICE
 
 RDBA     BSS    MXSY        TABLE OF SYSTEM DEVICE EST ORDINALS
 
 RDBB     BSS    MXSY+1      TABLE OF SYSTEM DEVICE MST ADDRESSES
 REB      SPACE  4,15
**        REB - RELEASE EMPTY READ BUFFER AND INTERLOCK NEXT BUFFER.
*
*         ENTRY  INPUT REQUEST DECODED BY LBM MAIN ROUTINE.
*
*         EXIT   TO *RDB* TO INTERLOCK NEXT BUFFER IF *REB* FUNCTION.
*                TO *LBMX* IF *REN* FUNCTION.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 6.
*                X - ALL.
*
*         CALLS  ANB, CSD, CHA, DCC, DCH, LCC, SNS, SRC.
 
 
 REB      BSS    0           ENTRY
          SX7    B0+         CLEAR *REN* FUNCTION FLAG
 
*         ENTRY FROM *REN* FUNCTION.
*         DECREMENT READ ACCESS COUNT.
 
 REB1     SA1    BIDX        GET CONTROL BUFFER INDEX
          SA7    REBA
          BX0    X1
          BX6    X1          SET CONTROL BUFFER INTERLOCK
          SA6    INLB
          TX7    DRDB        SET READ AS CURRENT LIST
          SA7    CLST
          LX6    CBTLS
          MX3    12
          TA2    X6+LSLK,CBT READ ACCESS COUNT WORD
          BX5    X3*X2       GET ACCESS COUNT
          AX5    49
          ZR     X5,REB2     IF COUNT = 0 OR 1
          SX4    B1
          LX4    48
          IX6    X2-X4       DECREMENT COUNT
          SA6    A2
          EQ     REB4        CHECK READ THRESHOLD
 
 REB2     BX6    -X3*X2      CLEAR ACCESS COUNT
          SA6    A2
          SA2    A2+IOLK-LSLK
          NO
          LX2    59-55
          NG     X2,REB4     IF SYSTEM FILE BUFFER, LEAVE ON CHAIN
          SB6    REB3        RETURN ADDRESS FOR ROUTINE *DCC*
          EQ     DCC         DELINK CONTROL BUFFER FROM CONTROL BUFFER
 
 REB3     SB6    REB4        LINK TO EMPTY LIST
          TX1    EMTB
          EQ     LCC         LINK CONTROL BUFFER
 
*         CHECK FOR READ-AHEAD TRIGGER.
 
 REB4     SA1    BIDX        GET READ THRESHOLD BIT
          LX1    CBTLS
          TA1    X1+IOLK,CBT
          BX0    X1
          BX6    X6-X6       CLEAR CONTROL BUFFER INTERLOCK
          SA6    INLB
          SA1    LSEC        SAVE LOGICAL TRACK AND SECTOR
          SA2    LTRK
          BX6    X1
          BX7    X2
          SA6    OLSC
          SA7    BCNT
          LX0    59-58       TEST READ THRESHOLD
          PL     X0,REB18    IF NOT READ-AHEAD TRIGGER BUFFER
          BX7    X7-X7
          SA3    RBTH        SET BUFFER COUNT TO ALLOCATE
          BX6    -X3
          ERRNZ  RBCT+1-RBTH  CODE DEPENDS ON VALUE
          SA6    A3-B1
          SA1    REBA
          ZR     X1,REB7     IF *REB* FUNCTION
 
*         FIND LAST CONSECUTIVE BUFFER ON HASH CHAIN.
 
 REB5     ZR     X6,REB18    IF ALL BUFFERS ALLOCATED
          SB6    REB6
          EQ     SNS         SET NEXT SECTOR
 
 REB6     NZ     X0,REB18    IF END OF LOGICAL TRACK CHAIN
 REB7     SB6    REB8
          TEQ    (/BUFIO/CSD,BIOMMF,/BUFIO/CHA)  CHECK BUFFER STATUS
 
 REB8     ZR     X2,REB9     IF END OF CONSECUTIVE CHAIN
          NG     X2,REB18    IF BUFFER CANNOT BE ALLOCATED
          ZR     X0,REB9     IF END OF CONSECUTIVE CHAIN
          SB6    REB5
          EQ     CAT         CHECK ALLOCATION TRIGGER
 
*         ALLOCATE ADDITIONAL BUFFERS.
 
 REB9     SA3    RBTH        SET BUFFER COUNT TO ALLOCATE
          BX6    -X3
          ERRNZ  RBCT+1-RBTH  CODE DEPENDS ON VALUE
          SA6    A3-B1
 REB10    SB6    REB11
          EQ     ANB         ALLOCATE NEXT BUFFER
 
 REB11    ZR     X0,REB18    IF NO BUFFERS AVAILABLE
          SB6    REB12
          EQ     CAT         CHECK ALLOCATION TRIGGER
 
 REB12    TA7    IORQ        INITIATE I/O
          XJ
 
 REB13    ZR     X6,REB18    IF ALL BUFFERS ALLOCATED
          SB6    REB14
          EQ     SNS         SET NEXT SECTOR
 
 REB14    NZ     X0,REB18    IF EOI
          SB6    REB15
          TEQ    (/BUFIO/CSD,BIOMMF,/BUFIO/CHA)  CHECK BUFFER STATUS
 
 REB15    ZR     X2,REB10    IF FIRST ACCESS TO HASH ENTRY
          NG     X2,REB18    IF BUFFER CANNOT BE ALLOCATED
          ZR     X0,REB10    IF BUFFER NOT FOUND
          SB6    REB13
          EQ     CAT         CHECK ALLOCATION TRIGGER
 
*         CHECK FOR NEXT BUFFER AVAILABLE FOR RESPONSE.
 
 REB18    SA1    REBA        GET FUNCTION FLAG
          NZ     X1,LBMX     IF *REN* FUNCTION
          SA1    BCNT        GET ORIGINAL LTRK
          SA2    OLSC        GET ORIGINAL LSEC
          BX6    X1
          BX7    X2
          SA6    LTRK
          SA7    LSEC
          SX6    B1          SET BUFFER COUNT TO ALLOCATE
          SA6    A1
          SA6    DTSF        SET DATA STREAMING FLAG
          EQ     RDB         USE READ FUNCTION CODE
 
 
 REBA     CON    0           *REN* FUNCTION FLAG
 REN      SPACE  4,10
**        REN - RELEASE READ BUFFER.
*
*         ENTRY  INPUT REQUEST DECODED BY LBM MAIN ROUTINE.
*
*         EXIT   CONTROL GIVEN TO *REB*.
*
*         USES   A - 7.
*                X - 7.
 
 
 REN      BSS    0           ENTRY
          SX7    1           INDICATE *REN* FUNCTION
          EQ     REB1        USE *REB* CODE
 RFB      SPACE  4,10
**        RFB - RELEASE AND FLUSH BUFFER.
*
*         ENTRY  INPUT REQUEST DECODED BY LBM MAIN ROUTINE.
*
*         EXIT   TO *FLB1*.
*
*         USES   A - 2.
*                X - 0, 2.
 
 
 RFB      BSS    0           ENTRY
          SA2    BIDX        GET BUFFER INDEX
          BX6    X2
          LX2    CBTLS
          SA6    INLB        INTERLOCK BUFFER
          NZ     X2,FLB1     IF BUFFER INDEX
          EQ     /PROGRAM/HNG  HANG CALLER
 RWB      SPACE  4,15
**        RWB - REWRITE BUFFER.
*
*         ENTRY  INPUT REQUEST DECODED BY LBM MAIN ROUTINE.
*
*         EXIT   CONTROL GIVEN TO LBMX.
*
*         USES   A - 1, 6.
*                X - 1, 6.
*
*         CALLS  WTB.
 
 
 RWB      BSS    0           ENTRY
          SA1    LSEC        FORCE PREREAD
          SX6    X1+1
          SA6    OLSC
          MX6    -1          BYPASS CHECK OF I/O ACTIVE COUNT
          SA6    BCNT
*         EQ     WTB         USE *WTB* FUNCTION
 WTB      SPACE  4,15
**        WTB - WRITE BUFFER.
*
*         ENTRY  INPUT REQUEST DECODED BY LBM MAIN ROUTINE.
*
*         EXIT   CONTROL GIVEN TO LBMX.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 6.
*                X - 0, 1, 2, 3, 4, 6, 7.
*
*         CALLS  ANB, CSD, CHA, CHT, DCC, SBB, SRC, SRP.
 
 
 WTB      BSS    0           ENTRY
          SA1    ANBA        GET DATA WRITTEN THRESHOLD
          TX7    MDWB        GET UPPER LIMIT
          SX6    X1+B1       UPDATE THRESHOLD FOR WRITE
          IX7    X6-X7
          PL     X7,WTB1     IF AT UPPER LIMIT
          SA6    A1+         SAVE NEW THRESHOLD
 WTB1     SX7    0           CLEAR PUSH STACK
          TX6    WRTB        SET WRITE AS CURRENT LIST
          SA6    CLST
 WTB2     SB6    WTB3        *CHA* RETURN ADDRESS
          TEQ    (/BUFIO/CSD1,BIOMMF,/BUFIO/CHA)  CHECK BUFFER STATUS
 
 WTB3     ZR     X2,WTB12    IF FIRST ACCESS
          NG     X2,WTB17    IF BUFFER CANNOT BE ACCESSED OR ALLOCATED
          ZR     X0,WTB9     IF CONTROL BUFFER NOT FOUND
          SX6    X0+         BUFFER ORDINAL
          SA6    INLB        SET CONTROL BUFFER INTERLOCK
          LX6    CBTLS
          TA2    X6+LSLK,CBT
          MX3    12
          BX3    X3*X2
          NZ     X3,SBB      IF READ OR WRITE BUFFER
          TA2    X6+IOLK,CBT
          NG     X2,WTB8     IF I/O INTERLOCK SET
          SX7    X0+         SAVE BUFFER ORDINAL
          SA7    FCBI
          SB6    WTB4        RETURN ADDRESS FOR ROUTINE *DCC*
          EQ     DCC         DELINK CONTROL BUFFER FROM CONTROL BUFFER
 
 WTB4     SB6    WTB6        LINK TO WRITE LIST
          TX1    WRTB
          EQ     LCC         LINK CONTROL BUFFER
 
 WTB6     BX1    X0          GET ADDRESS OF CONTROL BUFFER
          LX1    CBTLS
          TA2    X1+IOLK,CBT SET WRITE DATA ACCESS FLAG
          MX3    12          CLEAR OLD ACCESS FLAGS
          BX2    -X3*X2
          MX3    1
          LX3    57-59
          BX6    X2+X3
          SA6    A2
          TA2    X1+LSLK,CBT SET WRITE INTERLOCK
          MX3    12
          BX2    -X3*X2
          MX3    1
          BX6    X2+X3
          SA6    A2
          EQ     LBMX        EXIT
 
 WTB8     SA3    OPAR
          TA2    X6+LSLK,CBT CHECK RECALL CONTROL
          NZ     X3,SBB      IF RECALL NOT ALLOWED
          MX3    -24
          BX3    -X3*X2
          NZ     X3,SBB      IF RECALL CONTROL SET
          BX6    X0
          SA6    FCBI
          SA1    RPRM        GET RECALL PARAMETER
          SX6    B1+B1
          LX6    24
          BX6    X6+X1
          LX6    12
          BX6    X6+X0
          TA6    IORQ
          XJ                 SET RECALL CONTROL
 
          NZ     X6,SRR      IF FUNCTION ACCEPTED
          EQ     SBB         SET BUFFER BUSY RESPONSE
 
*         CHECK FOR AMOUNT OF ACTIVITY ON DEVICE.
 
 WTB9     SA2    MSTA        CHECK DEVICE ACTIVITY
          SA2    X2+DALL
          SX3    77B
          LX2    12
          BX4    X3*X2
          SX2    X4-DACL
          NG     X2,WTB12    IF DEVICE ACTIVITY OKAY
          TX3    A5-1,-SP
          ZR     X3,WTB10    IF PSEUDO PP CALL
          SA2    A5+B1
          LX2    59-4
          NG     X2,WTB12    IF *1MV* CALL
 WTB10    SA4    BCNT
          PL     X4,SBB      IF NOT CALLED BY *RWB*
 
*         ALLOCATE A BUFFER FOR WRITE.
 
 WTB12    SB6    WTB13       RETURN ADDRESS FOR ROUTINE *ANB*
          EQ     ANB         ALLOCATE NEXT BUFFER
 
 WTB13    ZR     X0,SBB      IF BUFFER NOT AVAILABLE
          SX6    X0+         SAVE BUFFER ORDINAL FOR RESPONSE
          SA6    FCBI
          SA2    LSEC        CHECK FOR I/O ON 4K BOUNDARY
          SA3    OLSC
          IX3    X3-X2
          ZR     X3,WTB6     IF ON FIRST PRU OF BUFFER
          SB6    WTB14       RETURN ADDRESS FOR ROUTINE *DCC*
          EQ     DCC         DELINK CONTROL BUFFER FROM CONTROL BUFFER
 
 WTB14    SB6    WTB15       LINK TO READ LIST
          TX1    DRDB
          EQ     LCC         LINK CONTROL BUFFER
 
 WTB15    SB6    WTB16       RETURN ADDRESS FOR ROUTINE *SRC*
          EQ     SRC         SET RECALL CONTROL
 
 WTB16    SX6    X0+         INITIATE I/O ON BUFFER
          TA6    IORQ
          XJ
 
          EQ     SRR         SET RECALL REPLY
 
 WTB17    SX6    X2+2
          ZR     X6,SBB      IF SHARED DEVICE BUFFER CANNOT BE ACCESSED
          SX6    B1          SET TO COUNT HASH TABLE FULL
          SB6    SBB         EXIT TO SET BUFFER BUSY
          LX6    24
          EQ     CHT         UPDATE COUNTERS
 ANB      TITLE  SUBROUTINES.
 ANB      SPACE  4,20
**        ANB - ALLOCATE NEXT BUFFER.
*
*         ENTRY  (X7) = BUFFERS ALLOCATED STACK.
*                (B6) = RETURN ADDRESS.
*                (B3) = SCRATCH AREA *SCRC* ADDRESS.
*                (CHEA) = CURRENT HASH ENTRY ADDRESS.
*                (CLST) = ADDRESS OF CURRENT LIST CONTROL WORD.
*                (SFRF) = SYSTEM FILE READ FLAG.
*
*         EXIT   (X0) = CONTROL BUFFER INDEX ALLOCATED.
*                     = 0  IF NO BUFFER AVAILABLE.
*                ALLOCATED CONTROL BUFFER WILL CONTAIN
*                CORRECT PARAMETERS FOR THE REQUEST.
*
*         USES   A - 1, 2, 3, 4, 6.
*                B - 3, 6.
*                X - 0, 1, 2, 3, 4, 5, 6.
*
*         CALLS  CLP, DCC, DCH, LCC, LCH.
 
 
 ANB      BSS    0           ENTRY
          SA2    PUTO        PUT ORDINAL
          BX0    X0-X0       PRESET NO BUFFER FOUND
          LX2    PUTLS
          TA2    X2+UNCT,PUT READ *PUT*
          MX5    6
          SA1    A2+B1
          ERRNZ  UNCT+1-HSCT CODE DEPENDS ON VALUE
          MX4    -4
          LX2    -24-8
          BX6    X5*X1       PHYSICAL SECTORS PER I/O BUFFER
          BX3    -X4*X2
          LX6    6
          LX2    59-58+32
          SA6    ANBD
          NZ     X3,/MONITOR/RB6  IF TOO MANY REQUESTS ON UNIT
          PL     X2,ANB1     IF *RW* FLAG NOT SET
          LX1    59-12-8
          ERRNZ  RCTH-400B   VALUE MUST BE 400B
          NG     X1,/MONITOR/RB6  IF TOO MANY REQUESTS PROCESSED
 ANB1     SX6    B6          SAVE (B6)
          SA6    B3
          SA6    ANBA+1      SET DATA WRITTEN NOT SKIPPED
          SB3    B3+1
          TB6    EMTB        INITIALIZE LIST INDEX
 ANB2     SA1    B6          GET LIST BASE WORD
          SX0    X1          GET FIRST CONTROL BUFFER ON LIST
          ZR     X0,ANB20    IF LIST IS EMPTY
 ANB3     BX6    X0          SET CONTROL BUFFER INTERLOCK
          SA6    INLB
          LX6    CBTLS
          TA2    X6+LSLK,CBT GET LIST LINK WORD
          MX5    12          GET ACCESS COUNT
          BX4    X5*X2
          NZ     X4,ANB19    IF ACCESS COUNT NOT ZERO
          SA4    A2-LSLK+IOLK  GET ACCESS FLAGS WORD
          NG     X4,ANB19    IF I/O INTERLOCK FLAG IS SET
          LX4    59-57
          PL     X4,ANB7     IF NOT WRITE DATA
 
*         AVOID FLUSH TO DOWN DEVICE.
 
          SA4    A2+FSTC-LSLK  GET EST ORDINAL FROM CONTROL BUFFER
          BX6    X5*X4
          LX6    -48
          CX4    X6,EST      CONVERT EST ORDINAL TO OFFSET
          SX6    B1
          TA4    X4+EQDE,EST
          LX4    59-49
          LX3    X4,B1
          PL     X4,ANB4     IF DEVICE NOT DOWN
          NG     X3,ANB19    IF DEVICE IS DOWN
 
*         WRITE BUFFER FOUND, FLUSH TO DISK.
 
 ANB4     TA2    WRTBC,IBST  COUNT WRITE BUFFER REALLOCATED (FLUSHED)
          IX6    X2+X6
          SA6    A2
          SX6    X0+
          TA6    IORQ
          XJ
 
          SB6    ANB5        RETURN ADDRESS FOR ROUTINE *DCC*
          EQ     DCC         DELINK CONTROL BUFFER FROM CONTROL BUFFER
 
 ANB5     SB6    ANB6        LINK TO DATA WRITTEN LIST
          TX1    DWTB
          EQ     LCC         LINK CONTROL BUFFER
 
 ANB6     SX0    B0+         CLEAR BUFFER FOUND
          SA1    ANBA+1
          NZ     X1,ANBX     IF DATA WRITTEN LIST PROCESSED
          TB6    DWTB        DATA WRITTEN LIST WAS SKIPPED INITIALLY
          EQ     ANB2        PROCESS DATA WRITTEN LIST
 
*         UPDATE CONTROL BUFFER FOR NEW REQUEST.
 
 ANB7     TX2    B6-1,-BLMB  INCREMENT SELECTED LIST
          TA2    X2,IBST
          SX6    1
          IX6    X2+X6
          SA6    A2
          SB6    ANB8        RETURN ADDRESS FOR ROUTINE *DCC*
          EQ     DCC         DELINK CONTROL BUFFER FROM BUFFER LIST
 
 ANB8     SB6    ANB9        RETURN ADDRESS FOR ROUTINE *DCH*
          EQ     DCH         DELINK CONTROL BUFFER FROM HASH LINK
 
 ANB9     SA3    CHEA
          SA2    LSEC        GET CURRENT LOGICAL SECTOR
          SA1    X3
          BX5    X1
          NZ     X5,ANB11    IF NOT FIRST ENTRY
          SA3    LTRK        FORM HASH ENTRY
          LX2    24
          BX5    X2
          LX2    12
          BX5    X5+X2
          LX3    48
          BX6    X5+X3
          SA6    A1+
          EQ     ANB14       CREATE NEW HASH ENTRY
 
 ANB11    MX6    12          CHECK FIRST AND LAST LIMITS
          LX6    36
          BX4    X6*X5
          LX6    12
          BX3    X6*X5
          AX4    24
          AX3    36
          IX6    X4-X2
          PL     X6,ANB12    IF LAST LIMIT VALID
          BX4    X2
          EQ     ANB13       MODIFY HASH ENTRY
 
 ANB12    IX6    X2-X3       CHECK FIRST LIMIT
          BX3    X2
          PL     X6,ANB14    IF FIRST LIMIT VALID
 ANB13    LX3    36
          LX4    24
          MX6    24
          LX6    48
          BX5    -X6*X5      CLEAR OLD LIMITS
          BX5    X5+X4       ADD NEW LIMITS
          BX6    X5+X3
          SA6    A1
 ANB14    SB6    ANB15       *CLP* RETURN ADDRESS
          EQ     CLP         CONVERT LOGICAL TO PHYSICAL DISK ADDRESS
 
*         (X0) = CONTROL BUFFER ORDINAL.
*         (X1) = PHYSICAL CYLINDER NUMBER.
*         (X3) = PHYSICAL UNIT NUMBER.
*         (X4) = 48/, 6/PHYSICAL TRACK, 6/PHYSICAL SECTOR.
 
 ANB15    BX2    X0          CONTROL BUFFER ORDINAL
          LX2    CBTLS
          LX3    48
          LX1    36
          LX4    24
          BX6    X3+X4
          SA4    LSEC        BUILD LOGICAL NEXT SECTOR IN BUFFER
          SX3    LSLB/4
          IX5    X3+X4
          BX6    X6+X1
          BX6    X5+X6
          TA6    X2+PAD1,CBT
          SA2    ANBD        PHYSICAL SECTORS PER I/O BUFFER
          MX5    -1
          AX2    1
          BX5    -X5*X2      SECTOR INCREMENT - SECTOR SIZE .EQ. 8K
          AX2    1           SECTOR INCREMENT - SECTORS SIZES .LT. 8K
          LX5    24
          LX2    24
          BX2    X2+X3       MERGE LOGICAL SECTOR INCREMENT
          ERRNZ  PSLB-4      CODE PRESETS SECTOR CONTROL WORD WORDS
          IX6    X6+X2       *PAD2*
          SA6    A6+B1
          ERRNZ  PAD2-PAD1-1  CODE DEPENDS ON VALUE
          IX6    X6+X2       *PAD3*
          IX6    X6+X5       INCREMENT FOR 8K SECTORS
          SA6    A6+B1
          ERRNZ  PAD3-PAD2-1  CODE DEPENDS ON VALUE
          IX6    X6+X2       *PAD4*
          AX6    12          SET NO LINK IN LAST CONTROL WORD
          LX6    12
          SA6    A6+B1
          ERRNZ  PAD4-PAD3-1  CODE DEPENDS ON VALUE
          SA1    FNTA        BUILD PSEUDO-*FST*
          SX5    B1
          IX1    X1+X5
          ERX1   X1
          SA2    LTRK
          MX3    24
          BX6    X1*X3       EQUIPMENT
          LX2    24
          LX4    12
          BX6    X6+X2       LOGICAL TRACK
          BX6    X6+X4       LOGICAL SECTOR
          SA6    A6+B1       SET *FST* IN CONTROL BUFFER
          ERRNZ  FSTC-PAD4-1 INDEXES MUST BE CONSECUTIVE
          SA2    SFRF        SET/CLEAR SYSTEM FILE READ FLAG
          BX1    X0
          BX6    X2
          LX1    CBTLS
          MX3    -48
          SA2    A6+B1
          ERRNZ  IOLK-FSTC-1 CODE DEPENDS ON VALUE
          SA4    A2+B1
          ERRNZ  HSLK-IOLK-1 CODE DEPENDS ON VALUE
          BX2    -X3*X2
          BX6    X6+X2
          SA1    CLST        LINK TO CURRENT LIST
          SB6    ANB18
          SA6    A2
          BX5    -X3*X4      CLEAR ERROR DATA
          SA3    CHAN
          SA2    CHRV
          TX4    A5-1,-SP
          ZR     X4,ANB16    IF PSEUDO PP
          SA2    A5+1
 ANB16    LX2    59-4
          PL     X2,ANB17    IF CHANNEL NOT SELECTED BY CALLER
          LX3    54
          SA2    A4-HSLK+PAD4
          BX6    X2+X3       MERGE CHANNEL INTO *PAD4*
          SA6    A2
          SX4    B1+
          LX4    58
          BX5    X4+X5       MERGE CHANNEL SELECTION FLAG INTO *HSLK*
 ANB17    BX6    X5
          SA6    A4
          EQ     LCC         LINK CONTROL BUFFER
 
 ANB18    SA2    B3-B1       RESTORE (B6)
          SB3    B3-B1
          SA1    CHEA
          SB6    X2
          EQ     LCH         LINK CONTROL BUFFER TO HASH CHAIN
 
*         GET NEXT CONTROL BUFFER ON THREAD.
 
 ANB19    BX1    X0          GET CONTROL BUFFER ADDRESS
          LX1    CBTLS
          TA2    X1+LSLK,CBT READ LIST LINK WORD
          MX3    -12         GET FORWARD LINK
          AX2    24
          BX0    -X3*X2
          NZ     X0,ANB3     IF ANOTHER BUFFER TO CHECK
          TX1    B6,-DWTB
          NZ     X1,ANB20    IF NOT PROCESSING DATA WRITTEN LIST
          SA1    ANBA+1
          ZR     X1,ANBX     IF DATA WRITTEN SKIPPED INITIALLY
 
*         CHECK NEXT LIST.
 
 ANB20    SB6    B6+1        UPDATE LIST INDEX
          TX6    B6,-DWTB
          NZ     X6,ANB22    IF NOT DATA WRITTEN LIST
 
*         IF A BUFFER IS ACCESSED, BUT NOT RELEASED/FLUSHED IT CAN
*         STAY ON THE READ OR WRITE LIST INDEFINITELY UNLESS THERE IS
*         REGULAR ALLOCATION FROM BOTH LISTS.  THE FOLLOWING LOGIC
*         WILL CAUSE THE OLDEST BUFFER TO BE ALLOCATED IF IT STAYS THE
*         OLDEST FOR AN EXTENDED PERIOD OF TIME.
 
          SA1    RTCL        CURRENT TIME - TIME LAST CHECKED
          SA2    ANBB
          MX5    -36
          BX1    -X5*X1
          IX2    X1-X2
          SX6    3000D       CHECK EVERY THREE SECONDS
          IX5    X2-X6
          BX6    X1
          NG     X5,ANB21    IF TIME NOT ELAPSED
          SA6    A2          SET NEW TIME
          SA1    B6+B1       CHECK READ LIST
          ERRNZ  DRDP-DWTP-1 CODE DEPENDS ON VALUE
          SA2    ANBC
          BX4    X1-X2
          SX5    X1
          SX4    X4
          SB6    A1+         SET READ LIST
          ZR     X4,ANB2     IF SAME BUFFER, ALLOCATE FROM READ LIST
          SA1    A1+B1       CHECK WRITE LIST
          ERRNZ  DRDP-DWTP-1 CODE DEPENDS ON VALUE
          AX2    18
          BX4    X1-X2
          SX1    X1
          SB6    A1+
          LX1    18          SAVE FIRST BUFFERS ON READ AND WRITE LIST
          SX4    X4+
          BX6    X1+X5
          SA6    A2
          NZ     X4,ANB21    IF NOT SAME BUFFER ON WRITE LIST
          AX1    18-CBTLS
          TA2    X1+LSLK,CBT
          MX5    12
          BX6    X5*X2
          NZ     X6,ANB21    IF BUFFER IN USE
          SA2    A2+IOLK-LSLK
          NG     X2,ANB21    IF I/O INTERLOCK
          SA6    ANBA+1      SET DATA WRITTEN SKIPPED FLAG
          EQ     ANB2        FLUSH BUFFER
 
 ANB21    TA1    DWTB
          BX6    X6-X6
          SB6    A1
          SA2    ANBA        GET DATA WRITTEN THRESHOLD
          AX1    36
          IX1    X2-X1
          NG     X1,ANB2     IF COUNT .GT. THRESHOLD
          SB6    B6+B1       SKIP DATA WRITTEN LIST
          SA6    A2+B1       SET SKIPPED FLAG
 ANB22    TX1    B6,-WRTB
          PL     X1,ANBX     IF ALL LISTS HAVE BEEN CHECKED
          TA1    DRDB        GET READ COUNT
          TA2    WRTB        GET WRITE COUNT
          AX1    36
          AX2    36
          IX1    X1-X2
          NG     X1,ANB23    IF WRITE LIST LARGER
          TB6    DRDB
          EQ     ANB2        CHECK READ LIST
 
 ANB23    TB6    WRTB
          EQ     ANB2        CHECK WRITE LIST
 
*         EXIT ALLOCATE BUFFER ROUTINE.
 
 ANBX     SA2    B3-1        RESTORE (B6)
          SB3    B3-B1
          SB6    X2
          JP     B6          RETURN
 
 ANBA     CON    DWLT        DATA WRITTEN LIST TRESHOLD
          CON    0           0 = DATA WRITTEN LIST SKIPPED
 ANBB     CON    0           TIME OF LAST FIRST BUFFER CHECK
 ANBC     CON    0           24/,18/ WRITE BUFFER,18/ READ BUFFER
 ANBD     CON    0           PHYSICAL SECTORS PER I/O BUFFER
 CAT      SPACE  4,15
**        CAT - CHECK READ BUFFER ALLOCATION TRIGGER.
*
*         ENTRY  (X0) = CONTROL BUFFER ORDINAL.
*                (B6) = RETURN ADDRESS.
*
*         EXIT   READ-AHEAD TRIGGER FLAG SET IN CBT IF THRESHOLD
*                  REACHED.
*                (X6) = READ BUFFER COUNT DECREMENTED.
*                (X7) = BUFFER ORDINAL.
*
*         USES   A - 2, 3, 6, 7.
*                X - 0, 2, 3, 4, 6, 7.
 
 
 CAT      BSS    0           ENTRY
          SA3    RBCT        READ BUFFER COUNT
          SA2    DBAT
          BX7    X0          SET BUFFER ORDINAL
          IX2    X2+X3
          NZ     X2,CAT1     IF NOT TRIGGER BUFFER
          SX4    1
          LX0    CBTLS       *CBT* INDEX
          LX4    58-0
+         TA2    X0+IOLK,CBT **** PERFORM IN ONE WORD ****
          BX6    X2+X4       **** PERFORM IN ONE WORD ****
          SA6    A2          **** PERFORM IN ONE WORD ****
 CAT1     SX6    X3+B1       DECREMENT BUFFER COUNT
          SA6    A3
          JP     B6          RETURN
 CHT      SPACE  4,10
**        CHT - COUNT HASH TABLE EVICTS AND FULLS.
*
*         ENTRY  (X6) = INCREMENT OF ONE POSITIONED FOR UPDATE.
*                (B6) = EXIT ADDRESS.
*
*         EXIT   PUT UPDATED IF COUNT .LT. 2048.
*
*         USES   A - 1, 6.
*                X - 1, 3, 6.
 
 
 CHT      BSS    0           ENTRY
          SA1    PUTO
          LX6    11          POSITION INCREMENT TO CHECK OVERFLOW
          LX1    PUTLS
          TA1    X1+ACRJ,PUT CHECK FOR OVERFLOW
          BX3    X6*X1
          LX6    -11
          NZ     X3,CHT1     IF COUNTER FULL
          IX6    X1+X6
          SA6    A1
 CHT1     JP     B6          RETURN
 CHA      SPACE  4,40
**        CHA - CALCULATE HASH ADDRESS.
*
*         ENTRY  (B6) = RETURN ADDRESS.
*                (X7) = 0 IF BUFFER TO BE INTERLOCKED OR ALLOCATED AND
*                       NO BUFFERS ARE ALREADY ALLOCATED.
*                (X7) .GT. 0 IF BUFFER TO BE INTERLOCKED OR ALLOCATED
*                     AND BUFFERS ARE ALREADY ALLOCATED.
*                (X7) .LT. 0 IF TO LOCATE HASH TABLE ENTRY ONLY.
*                (MSTA) = *MST* ADDRESS.
*                (LTRK) = LOGICAL TRACK.
*                (LSEC) = LOGICAL SECTOR NUMBER.
*
*         EXIT   (X2) = 0 FIRST ACCESS.
*                     .GT. 0  IF ENTRY FOUND.
*                     = -1 IF HASH TABLE FULL.
*                (X1) = HASH ENTRY ADDRESS.
*                     = 0  IF HASH TABLE BUSY.
*                (X0) = CONTROL BUFFER INDEX.
*                     = 0  IF BUFFER NOT FOUND.
*                       NOTE - (X0) VALID ONLY IF (X2) .GT. 0.
*                (CHEA) = HASH ENTRY ADDRESS.
*                (HTA)  = HASH TABLE ADDRESS.
*                (PUTO) = 24/SUSL, 18/RLSN, 18/PUTO
*                         SUSL = SINGLE UNIT SECTOR LIMIT.
*                         RLSN = RELATIVE SECTOR NUMBER IN UNIT.
*                                (R(LS/SL))
*                         PUTO = *PUT* ORDINAL.
*
*                TO *LBMXS* IF ADDRESS ERROR OR INACCESSIBLE DEVICE.
*
*         USES   A - 1, 2, 3, 4, 6.
*                B - 5, 6.
*                X - 0, 1, 2, 3, 4, 5, 6.
*
*         CALLS  CDA, DCC, DCH, LCC.
*
*         NOTE   HASH ENTRY FORMAT.
*         12/TRK, 12/FLS, 12/LLS, 12/0, 12/BI.
*         TRK = LOGICAL TRACK.
*         FLS = FIRST LOGICAL SECTOR PRESENT.
*         LLS = LAST LOGICAL SECTOR PRESENT.
*         BI = FIRST CONTROL BUFFER ON HASH CHAIN.
*
*                HASH ALGORITHM.
*
*         LCMA = HTA + ( HTM .AND. ( LT * LCC ))
*
*         LCMA = ADDRESS IN I/O BUFFER OF FIRST ENTRY.
*         HTA = HASH TABLE BASE ADDRESS.
*         HTM = HASH TABLE MASK FROM THE MST.
*         LT = LOGICAL TRACK ADDRESS.
*         LLC = SUBLIST LENGTH FOR HASH TABLE SEARCH.
*
*         HASH CHAINS ARE BUILT BACKWARDS (HIGHEST LOGICAL SECTOR
*         NUMBERS AT THE BEGINNING OF THE CHAIN) SO THAT SEQUENTIAL
*         ACCESSES DO NOT HAVE TO CHAIN TO THE END TO ADD NEW
*         BUFFERS.
 
 
 CHA26    MX6    1           SET *ADDRESS ERROR* STATUS
          LX6    55-59
          EQ     LBMXS       EXIT WITH ERROR
 
 CHA      BSS    0           ENTRY
          MX5    -12
          NG     X7,CHA1     IF LOCATE ENTRY ONLY
          SB5    CHA1        SET *CDA* EXIT ADDRESS
          EQ     CDA         CHECK DEVICE ACCESSIBILITY
 
 CHA1     SA1    MSTA        MST ADDRESS
          SA4    X1+DILL     FETCH *PUT* ORDINAL OF FIRST UNIT
          SA2    A4-DILL+MDGL  FETCH SINGLE UNIT SECTOR LIMIT
          AX4    24
          BX6    -X5*X4      *PUT* ORDINAL
          AX2    36
          BX2    -X5*X2      SINGLE UNIT SECTOR LIMIT
          SA3    LSEC        LOGICAL SECTOR NUMBER
 CHA1.1   IX3    X3-X2
          NG     X3,CHA1.2   IF CORRECT *PUT* ENTRY FOUND
          LX6    PUTLS
          TA1    X6+HSCT,PUT CHECK NEXT *PUT* IN CHAIN
          BX6    -X5*X1      NEXT *PUT* ORDINAL
          ZR     X6,CHA26    IF LOGICAL SECTOR TOO LARGE
          EQ     CHA1.1      CHECK NEXT *PUT* ENTRY
 
 CHA1.2   IX3    X3+X2       R(LS/SL) = RLSN
          LX3    18
          LX2    36
          BX6    X6+X3
          BX6    X6+X2
          SA6    PUTO        SET PUTO = 24/SUSL, 18/RLSN, 18/PUTO
          LX6    PUTLS       FETCH HASH TABLE PARAMETERS
          TA1    X6+HSCT,PUT
          SA3    LTRK        LOGICAL TRACK
          MX6    -18
          AX1    24
          BX6    -X6*X1      BASE HASH TABLE ADDRESS
          AX4    12
          BX4    -X5*X4      EST ORDINAL
          CX2    X4,EST      CONVERT EST ORDINAL TO OFFSET
          TA4    X2+EQAE,EST GET PARTITION NUMBER FROM EST
          MX2    -4
          LX4    -18
          BX0    -X2*X4
          SX4    HATLE       COMPUTE HASH TABLE PARTITION OFFSET
          IX2    X0*X4
          IX6    X6+X2
          SA6    HTA         SET HASH TABLE ADDRESS
          AX1    18
          MX4    -9
          BX4    -X4*X1      HASH TABLE MASK
          ERRNZ  LLCV-4      CODE DEPENDS ON VALUE
          LX3    2
          BX3    X3*X4
          IX5    X3+X6
          BX6    X5
          SB5    LLCV
          SX0    B0          CLEAR EMPTY HASH ENTRY FLAG
 
*         SEARCH HASH ENTRIES FOR DATA MATCH.
 
 CHA1.3   SA1    X5          READ NEXT HASH ENTRY
          ZR     X1,CHA5     IF HASH ENTRY IS EMPTY
          MX3    12
          SA2    LTRK        CHECK FOR TRACK MATCH
          BX4    X3*X1
          LX4    12
          IX4    X4-X2
          NZ     X4,CHA6     IF WRONG TRACK
          LX3    -24
          SA2    LSEC        GET REQUESTED LOGICAL SECTOR
          BX4    X3*X1
          AX4    24
          IX4    X4-X2
          NG     X4,CHA4.1   IF OUR DATA NOT IN THIS HASH ENTRY
          LX3    12
          BX4    X3*X1
          AX4    36
          IX4    X2-X4
          MX3    -12
          NG     X4,CHA4.1   IF OUR DATA NOT IN THIS HASH ENTRY
 
*         SEARCH CONTROL BUFFERS LINKED TO THIS ENTRY
*         FOR A MATCH WITH THE REQUESTED DATA.
 
          BX0    -X3*X1      GET CONTROL BUFFER INDEX
 CHA2     BX6    X0
          LX6    CBTLS
          TA4    X6+FSTC,CBT
          AX4    12
          BX4    -X3*X4      ACTUAL SECTOR
          TA1    X6+HSLK,CBT
          IX6    X2-X4
          NG     X6,CHA4     IF OUR DATA BEFORE THIS BUFFER
          SA2    A5+B1
          NZ     X6,CHA4.1   IF OUR DATA BEYOND THIS BUFFER
          TX4    A5-1,-SP
          BX6    X6-X6
          LX2    59-4
          ZR     X4,CHA3     IF PSEUDO PP
          SA4    NCHV
          NZ     X4,CHA3     IF NO *CHRV* DATA PRESENT
          PL     X2,CHA3     IF NOT DEVICE VERIFICATION CALL
          MX6    -48
          PX4    B0          DEVICE VERIFICATION FLAG
          SA2    CHAN        CHANNEL SELECTED BY *1MV*
          BX6    -X6*X1      CLEAR *HSLK* BYTE 0
          BX6    X4+X6       SET DEVICE VERIFICATION FLAG
          SA6    A1+         UPDATE *HSLK*
          SA4    A1-HSLK+PAD4
          MX6    -54
          LX2    54          POSITION CHANNEL
          BX4    -X6*X4      CLEAR CHANNEL FIELD IN *PAD4*
          BX6    X4+X2       MERGE CHANNEL INTO *PAD4*
          SA6    A4+         UPDATE *PAD4*
          SA2    A5+
          LX2    59-42
          BX6    X6-X6
          NG     X2,CHA11    IF READ OPERATION
 CHA3     NG     X7,CHA4.2   IF LOCATE ENTRY ONLY
          NG     X1,CHA11    IF I/O ERROR, EVICT HASH ENTRY
          EQ     CHA4.2      SET UP EXIT CONDITIONS
 
 CHA4     AX1    24
          BX0    -X3*X1      GET FORWARD LINK
          NZ     X0,CHA2     IF NOT END OF HASH CHAIN
 CHA4.1   SX0    B0+
 CHA4.2   BX1    X5
          SX2    B1
          EQ     CHA24       SAVE HASH ADDRESS AND EXIT
 
 CHA5     NZ     X0,CHA6     IF PREVIOUS EMPTY ENTRY FOUND
          BX0    X5
 CHA6     SX4    B1+         UPDATE HASH ENTRY ADDRESS
          IX5    X5+X4
          SB5    B5-B1
          NZ     B5,CHA1.3   IF NOT END OF LIST CONTROL
          SB5    B6+
          NG     X7,CHA22    IF LOCATE ENTRY ONLY
          NZ     X0,CHA23    IF EMPTY ENTRY FOUND
          NZ     X7,CHA22    IF BUFFERS ALLOCATED
 
*         FIND A HASH ENTRY THAT HAS NO I/O ACTIVITY OR WRITE DATA.
*         IF ONE IS FOUND, EVICT IT AND RETURN FIRST ENTRY STATUS.
*         OTHERWISE SAVE STATUS OF I/O ACTIVITY AND COUNT OF CONTROL
*         BUFFERS ON EACH HASH ENTRY IN TABLE *CETS*.
 
          BX5    X6          RESET HASH ADDRESS
          SB5    LLCV+1      RESET LIST LENGTH
          BX6    X6-X6       ZERO BUFFER COUNT TABLE
 CHA7     SA6    B5+CETS-1
          SB5    B5-1
          NZ     B5,CHA7     IF PRESET NOT COMPLETE
          SB5    LLCV        RESET LIST LENGTH
 CHA8     SA1    X5          READ NEXT HASH ENTRY
          MX3    -12
          BX6    X6-X6
          BX0    -X3*X1
 CHA9     BX2    X6          UPDATE BUFFER COUNT
          SA1    B5+CETS-1
          SX6    X1+B1
          SA6    A1
          BX6    X2
          BX1    X0          GET ACCESS FLAGS
          LX1    CBTLS
          TA2    X1+IOLK,CBT
          NG     X2,CHA18    IF I/O INTERLOCK
          LX2    59-57
          PL     X2,CHA10    IF READ BUFFER
          SX6    B1          SET WRITE BUFFER FLAG
 CHA10    SA2    A2+B1
          ERRNZ  HSLK-IOLK-1 CODE DEPENDS ON VALUE
          MX3    12          GET FORWARD LINK
          LX2    24
          BX0    X3*X2
          LX0    12
          SA2    A2+LSLK-HSLK
          BX2    X3*X2
          NZ     X2,CHA18    IF NOT ZERO ACCESS COUNT
          NZ     X0,CHA9     IF ANOTHER BUFFER ON THREAD
          NZ     X6,CHA19    IF NOT ALL BUFFERS WERE READ
          SX6    B1          SET EVICTED READ HASH STATUS
          LX6    48
 
*         EVICT THE HASH TABLE ENTRY POINTED TO BY (X5).
 
 CHA11    SB5    B6          SAVE B6
          SA2    X5          READ HASH ENTRY
          SA6    CSBS
 CHA12    MX3    -12
          BX0    -X3*X2      GET INDEX
          SX6    X0+         SET CBT INTERLOCK
          SA6    INLB
          LX6    CBTLS
          TA2    X6+HSLK,CBT GET FORWARD HASH LINK
          LX2    -24
          BX6    -X3*X2
          SA6    CAFL
          ERRNZ  LSLK-HSLK-1 CODE DEPENDS ON VALUE
          SA1    A2+B1
          LX2    24          REPOSITION *HSLK*
          MX6    12
          BX6    X6*X1
          NZ     X6,CHA22    IF ACCESS COUNT NON-ZERO
          SA1    A2-B1
          ERRNZ  IOLK+1-HSLK  CODE DEPENDS ON VALUE
          BX6    X5
          SA6    CHAD
          BX6    X0
          NG     X1,CHA17    IF I/O INTERLOCK SET
          LX1    59-57
          PL     X1,CHA14    IF READ BUFFER
          TA6    IORQ        INITIATE I/O
          XJ
 
          SB6    CHA13       *DCC* RETURN ADDRESS
          EQ     DCC         DELINK CONTROL BUFFER FROM CONTROL BUFFER
 
 CHA13    SB6    CHA17       *LCC* RETURN ADDRESS
          TX1    DWTB
          EQ     LCC         LINK CONTROL BUFFER
 
 CHA14    SB6    CHA15       *DCC* RETURN ADDRESS
          EQ     DCC         DELINK CONTROL BUFFER FROM CONTROL BUFFER
 
 CHA15    SB6    CHA16       *DCH* RETURN ADDRESS
          EQ     DCH         DELINK CONTROL BUFFER FROM HASH LINK
 
 CHA16    SB6    CHA17       *LCC* RETURN ADDRESS
          TX1    EMTB
          EQ     LCC         LINK CONTROL BUFFER
 
 CHA17    SA3    CHAD        GET HASH ADDRESS
          SA2    CAFL        GET FORWARD LINK
          BX5    X3
          NZ     X2,CHA12    IF ANOTHER BUFFER TO EVICT
          SA2    X5
          SB6    B5+         RESTORE B6
          NZ     X2,CHA22    IF ALL BUFFERS NOT EVICTED
          SA4    CSBS
          BX6    X4
          SX0    X5
          SB6    CHA23       SET *CHT* EXIT ADDRESS
          EQ     CHT         UPDATE STATISTICS
 
 CHA18    MX6    59          SET I/O ACTIVE FLAG
          SA6    CETS+LLCV
 CHA19    SX1    1           UPDATE HASH ADDRESS
          IX5    X5+X1
          SB5    B5-B1
          NZ     B5,CHA8     IF NOT END OF LIST CONTROL
          SA1    CETS+LLCV
          NG     X1,CHA22    IF I/O ACTIVE
 
*         EVICT THE HASH ENTRY WITH THE SMALLEST BUFFER COUNT.
 
          SB5    LLCV        RESET LIST LENGTH
          SX3    B0+         PRESET INDEX AND MINIMUM VALUE
          SX2    LSLB*100B
 CHA20    SA1    X3+CETS
          IX4    X1-X2
          PL     X4,CHA21    IF THIS ENTRY NOT SMALLER
          BX6    X3          SAVE NEW INDEX
          BX2    X1          SAVE NEW VALUE
 CHA21    SB5    B5-B1
          SX3    X3+B1
          NZ     B5,CHA20    IF TABLE NOT SEARCHED
          SX6    X6-LLCV     ADJUST HASH ENTRY ADDRESS IN X5
          IX5    X5+X6
          SX6    B1          SET EVICTED WRITE HASH STATUS
          LX6    36
          EQ     CHA11       EVICT WRITE ENTRY
 
 CHA22    SX2    -B1         SET BUFFER BUSY STATUS
          SX1    B0
          EQ     CHA24       PROCESS RESPONSE
 
 CHA23    SB6    B5          RESTORE (B6)
          BX1    X0          SET FIRST ACCESS STATUS
          SX2    B0+
 CHA24    SX6    X1+         SAVE HASH ENTRY ADDRESS
          SA6    CHEA
          JP     B6          EXIT
 CLP      SPACE  4,20
**        CLP - CONVERT LOGICAL TO PHYSICAL.
*
*         ENTRY  (B6) = RETURN ADDRESS.
*                (AILE) = ALGORITHM INDEX.
*                (LTRK) = LOGICAL TRACK.
*                (PUTO) = 24/SUSL, 18/RLSN, 18/PUTO
*                         SUSL = SINGLE UNIT SECTOR LIMIT.
*                         RLSN = R(LS/SL).
*                         PUTO = *PUT* ORDINAL.
*
*         EXIT   (X0) = CONTROL BUFFER ORDINAL.
*                (X1) = PHYSICAL CYLINDER NUMBER.
*                (X3) = PHYSICAL UNIT NUMBER.
*                (X4) = 48/, 6/PHYSICAL TRACK, 6/PHYSICAL SECTOR.
*
*         USES   A - 1, 2, 3, 4.
*                B - 4, 5.
*                X - 1, 2, 3, 4, 5, 6.
 
 
 CLP      BSS    0           ENTRY
          SA2    PUTO
          SB5    X2          SAVE *PUT* ORDINAL
          AX2    18
          SX3    X2          R(LS/SL)
          AX2    18          SINGLE UNIT SECTOR LIMIT
          SA1    AILE        ALGORITHM INDEX
          SA4    LTRK        LOGICAL TRACK
          SB4    X1-AIDB
          MX6    -11
          BX4    -X6*X4
          JP     B4+TCLP     TRANSFER TO PROCESSOR
 
*         ENTER PROCESSOR WITH -
*
*         (B5) = *PUT* ORDINAL.
*         (X2) = SUSL.
*         (X3) = R(LS/SL).
*         (X4) = LT - 4000B.
 
 
**        885-42 CONVERSION (*DB*).
*
*         ALGORITHM -
*         SL = 1200B
*         LU = LS/SL
*         X  = BIT 0 OF LT
*         PC = BITS 1 - 10 OF LT
*         PT = (X*SL+R(LS/SL))/200B
*         PS = (R(X*SL+R(LS/SL))/200B)/4
 
 CLP3     LX4    -1          SIGN = BIT 0 OF LT = X
          SX1    X4          SET CYLINDER NUMBER
          AX4    59          SIGN EXTEND BIT 0
          BX4    X4*X2       BIT 0 OF LT * SL
          MX6    -7
          IX4    X4+X3       X*SL+R(LS/SL)
          BX6    -X6*X4
          AX4    7           PT
          ERRNZ  LSPTDB-200B CODE DEPENDS ON VALUE
          SX2    B5
          AX6    CFSDB       PS
          EQ     CLP8        COMPLETE PROCESSING
 
 
**        895 FULL TRACK CONVERSION (*DC*).
*
*         ALGORITHM -
*         SL = 1300B                            SECTOR LIMIT
*         LU = LS/SL                            LOGICAL UNIT
*         X  = BIT 0 OF LT
*         PC = BITS 1 - 10 OF LT                PHYSICAL CYLINDER
*         PT = (X*SL + R(LS/SL))/140B           PHYSICAL TRACK
*         PS = R((X*SL + R(LS/SL))/140B)/40B    PHYSICAL SECTOR
 
 CLP4     SX5    LSPTDC      LOGICAL SECTORS PER PHYSICAL TRACK
          SB4    CFSDC
          EQ     CLP6        PERFORM CONVERSION
 
 
**        819 CONVERSION (*DV* AND *DW*).
*
*         SL = 1440B
*         LU = LS/SL
*         X  = BIT 0 OF LT
*         PC = BITS 1 - 10 OF LT
*         PT = (X*SL+R(LS/SL))/240B
*         PS = (R(X*SL)+R(LS/SL))/240B)/10B
 
 CLP5     SX5    LSPTDV      LOGICAL SECTORS PER PHYSICAL TRACK
          SB4    CFSDV
 
*         PERFORM CONVERSION WITH -
*
*         (X3) = R(LS/SL).
*         (X4) = LT - 4000B.
*         (X5) = NUMBER OF LOGICAL SECTORS PER PHYSICAL TRACK.
*         (B4) = SHIFT FOR LOGICAL TO PHYSICAL SECTOR CONVERSION.
 
 CLP6     LX4    -1          SIGN = BIT 0 OF LT = X
          SX1    X4          SET CYLINDER NUMBER
          AX4    59          SIGN EXTEND BIT 0
          BX4    X4*X2       BIT 0 OF LT * SL
 
*         CONTINUE CONVERSION WITH -
*
*         (X1) = PHYSICAL CYLINDER NUMBER.
*         (X3)+(X4) = LOGICAL SECTOR NUMBER WITHIN CYLINDER.
*         (X5) = NUMBER OF LOGICAL SECTORS PER PHYSICAL TRACK.
*         (B4) = SHIFT FOR LOGICAL TO PHYSICAL SECTOR CONVERSION.
 
 CLP7     IX3    X4+X3       X*SL+R(LS/SL)
          PX6    X5
          PX4    X3
          NX6    X6
          SX2    B5+0        MOVE *PUT* ORDINAL
          FX4    X4/X6
          UX4,B5 X4
          LX4    X4,B5       PT
          IX6    X4*X5
          IX6    X3-X6
          AX6    B4          PS
 
*         COMPLETE PROCESSING WITH -
*
*         (X1) = PHYSICAL CYLINDER (PC).
*         (X4) = PHYSICAL TRACK (PT).
*         (X6) = PHYSICAL SECTOR (PS).
*         (X2) = *PUT* ORDINAL.
 
 CLP8     LX2    PUTLS
          LX4    6
          TA3    X2+UNCT,PUT FETCH UNIT NUMBER FROM *PUT*
          MX5    -6
          BX4    X6+X4       MERGE PHYSICAL TRACK AND SECTOR
          AX3    48
          BX3    -X5*X3
          JP     B6          RETURN
 
 
**        887 SMALL (4K BYTE) SECTOR CONVERSION (*DF*).
*
*         ALGORITHM -
*         SL = 1140B
*         LU = LS/SL
*         X  = BIT 0 OF LT
*         PC = BITS 1 - 10 OF LT
*         PT = (X*SL+R(LS/SL))/460B
*         PS = (R(X*SL+R(LS/SL))/460B)/10B
 
 CLP9     SX5    LSPTDF      LOGICAL SECTORS PER PHYSICAL TRACK
          SB4    CFSDF
          EQ     CLP6        PERFORM CONVERSION
 
 
**        887 LARGE (16K BYTE) SECTOR CONVERSION (*DH*).
*
*         ALGORITHM -
*         SL = 1300B
*         LU = LS/SL
*         X  = BIT 0 OF LT
*         PC = BITS 1 - 10 OF LT
*         PT = (X*SL+R(LS/SL))/540B
*         PS = (R(X*SL+R(LS/SL))/540B)/40B
 
 CLP10    SX5    LSPTDH      LOGICAL SECTORS PER PHYSICAL TRACK
          SB4    CFSDH
          EQ     CLP6        PERFORM CONVERSION
 
 
**        9853 (XMD) CONVERSION (*DN*).
*
*         ALGORITHM -
*         SL = 2140B
*         NN = ((LT*SL+LS)/40B)*10B
*         PC = NN/617B
*         PT = (R(NN/617B))/25B
*         PS = R((R(NN/617B))/25B)
 
 CLP11    SB4    CFSDN
          SX6    PSPTDN*PTCYDN  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTDN
*         EQ     CLP12       ENTER COMMON 9853/583X ALGORITHM
 
*         ENTER COMMON ALGORITHM FOR 9853/583X WITH -
*
*         (B4) = SHIFT FOR LOGICAL TO PHYSICAL SECTOR CONVERSION.
*         (X2) = SECTOR LIMIT.
*         (X3) = R(LS/SL).
*         (X4) = LT - 4000B.
*         (X5) = NUMBER OF PHYSICAL SECTORS PER PHYSICAL TRACK.
*         (X6) = NUMBER OF PHYSICAL SECTORS PER CYLINDER.
 
 CLP12    IX1    X4*X2       LT*SL
          IX4    X1+X3       LT*SL+LS
          PX3    X6
          AX4    B4          NN (CONVERT LOGICAL SECTORS TO PHYSICAL)
          NX3    X3
          PX1    X4
          SA2    MSTA
          FX1    X1/X3       NN / PHYSICAL SECTORS PER CYLINDER
          SA3    X2+SCYL     GET STARTING CYLINDER
          UX1,B4 X1
          MX2    -12
          LX3    -24
          LX1    B4          RELATIVE PHYSICAL CYLINDER
          BX2    -X2*X3      CYLINDER OFFSET
          IX3    X1*X6
          IX1    X1+X2       ABSOLUTE PHYSICAL CYLINDER
          SB4    B0
          BX3    -X3
          EQ     CLP7        CONVERT PT AND PS
 
 
**        5832 (1X SSD) CONVERSION (*EA*).
*
*         ALGORITHM -
*         SL = 240B
*         LU = LS/SL
*         NN = (LT*SL+R(LS/SL))/40B
*         PC = NN/14B
*         PT = R(NN/14B)/3
*         PS = R(R(NN/14B)/3)
 
 CLP13    SB4    CFSEA
          SX6    PSPTEA*PTCYEA  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTEA
          EQ     CLP12       ENTER COMMON 9853/583X ALGORITHM
 
 
**        5832 (2X SSD) CONVERSION (*EB*).
*
*         ALGORITHM -
*         SL = 500B
*         LU = LS/SL
*         NN = (LT*SL+R(LS/SL))/40B
*         PC = NN/30B
*         PT = R(NN/30B)/6
*         PS = R(R(NN/30B)/6)
 
 CLP14    SB4    CFSEB
          SX6    PSPTEB*PTCYEB  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTEB
          EQ     CLP12       ENTER COMMON 9853/583X ALGORITHM
 
 
**        5833 (1X/1XP SABRE) CONVERSION (*EC/ED*).
*
*         ALGORITHM -
*         SL = 1740B
*         LU = LS/SL
*         NN = (LT*SL+R(LS/SL))/40B
*         PC = NN/50B
*         PT = R(NN/50B)/6
*         PS = R(R(NN/50B)/6)
 
 CLP15    SB4    CFSEC
          SX6    PSPTEC*PTCYEC-SPSCEC  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTEC
          EQ     CLP12       ENTER COMMON 9853/583X ALGORITHM
 
 
**        5833 (2X/2XP SABRE) CONVERSION (*EE/EF*).
*
*         ALGORITHM -
*         SL = 3600B
*         NN = (LT*SL+LS)/40B
*         PC = NN/113B
*         PT = R(NN/113B)/13B
*         PS = R(R(NN/113B)/13B)
 
 CLP16    SB4    CFSEE
          SX6    PSPTEE*PTCYEE-SPSCEE  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTEE
          EQ     CLP12       ENTER COMMON 9853/583X ALGORITHM
 
 
**        5833 (3XP SABRE) CONVERSION (*EM*).
*
*         ALGORITHM -
*         SL = 2740B
*         NN = (LT*SL+LS)/40B
*         PC = NN/167B
*         PT = R(NN/167B)/21B
*         PS = R(R(NN/167B)/21B)
 
 CLP17    SB4    CFSEM
          SX6    PSPTEM*PTCYEM-SPSCEM  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTEM
          EQ     CLP12       ENTER COMMON 9853/583X ALGORITHM
 
 
**        5833 (4X SABRE) CONVERSION (*EN*).
*
*         ALGORITHM -
*         SL = 3640B
*         LU = LS/SL
*         NN = (LT*SL+R(LS/SL))/40B
*         PC = NN/232B
*         PT = R(NN/232B)/26B
*         PS = R(R(NN/232B)/26B)
 
 CLP18    SB4    CFSEN
          SX6    PSPTEN*PTCYEN-SPSCEN  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTEN
          EQ     CLP12       ENTER COMMON 9853/583X ALGORITHM
 
 
**        5838 (1X/1XP ELITE) CONVERSION (*EG/EH*).
*
*         ALGORITHM -
*         SL = 3240B
*         NN = (LT*SL+LS)/40B
*         PC = NN/51B
*         PT = R(NN/51B)/5B
*         PS = R(R(NN/51B)/5B)
 
 CLP19    SB4    CFSEG
          SX6    PSPTEG*PTCYEG-SPSCEG  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTEG
          EQ     CLP12       ENTER COMMON 9853/583X ALGORITHM
 
 
**        5838 (2X/2XP ELITE) CONVERSION (*EI/EJ*).
*
*         ALGORITHM -
*         SL = 3100B
*         NN = (LT*SL+LS)/40B
*         PC = NN/115B
*         PT = R(NN/115B)/11B
*         PS = R(R(NN/115B)/11B)
 
 CLP20    SB4    CFSEI
          SX6    PSPTEI*PTCYEI-SPSCEI  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTEI
          EQ     CLP12       ENTER COMMON 9853/583X ALGORITHM
 
 
**        5838 (3XP ELITE) CONVERSION (*EK*).
*
*         ALGORITHM -
*         SL = 3240B
*         NN = (LT*SL+LS)/40B
*         PC = NN/172B
*         PT = R(NN/172B)/16B
*         PS = R(R(NN/172B)/16B)
 
 CLP21    SB4    CFSEK
          SX6    PSPTEK*PTCYEK-SPSCEK  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTEK
          EQ     CLP12       ENTER COMMON 9853/583X ALGORITHM
 
 
**        5838 (4X ELITE) CONVERSION (*EL*).
*
*         ALGORITHM -
*         SL = 3140B
*         NN = (LT*SL+LS)/40B
*         PC = NN/236B
*         PT = R(NN/236B)/22B
*         PS = R(R(NN/236B)/22B)
 
 CLP22    SB4    CFSEL
          SX6    PSPTEL*PTCYEL-SPSCEL  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTEL
          EQ     CLP12       ENTER COMMON 9853/583X ALGORITHM
 
 
**        47444 (1X/1XP 3.5IN) CONVERSION (*EO/EP*).
*
*         ALGORITHM -
*         SL = 3240B
*         NN = (LT*SL+LS)/10B
*         PC = NN/274B
*         PT = R(NN/274B)/15B
*         PS = R(R(NN/274B)/15B)
 
 CLP23    SB4    CFSEO
          SX6    PSPTEO*PTCYEO-SPSCEO  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTEO
          EQ     CLP12       ENTER COMMON 9853/583X/47444 ALGORITHM
 
 
**        47444 (2X/2XP 3.5IN) CONVERSION (*ES/EU*).
*
*         ALGORITHM -
*         SL = 3240B
*         NN = (LT*SL+LS)/20B
*         PC = NN/274B
*         PT = R(NN/274B)/15B
*         PS = R(R(NN/274B)/15B)
 
 CLP24    SB4    CFSES
          SX6    PSPTES*PTCYES-SPSCES  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTES
          EQ     CLP12       ENTER COMMON 9853/583X/47444 ALGORITHM
 
 
**        47444 (3XP 3.5IN) CONVERSION (*EV*).
*
*         ALGORITHM -
*         SL = 3200B
*         NN = (LT*SL+LS)/20B
*         PC = NN/426B
*         PT = R(NN/426B)/23B
*         PS = R(R(NN/426B)/23B)
 
 CLP25    SB4    CFSEV
          SX6    PSPTEV*PTCYEV-SPSCEV  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTEV
          EQ     CLP12       ENTER COMMON 9853/583X/47444 ALGORITHM
 
 
**        47444 (4X 3.5IN) CONVERSION (*EW*).
*
*         ALGORITHM -
*         SL = 3200B
*         NN = (LT*SL+LS)/20B
*         PC = NN/560B
*         PT = R(NN/560B)/31B
*         PS = R(R(NN/560B)/31B)
 
 CLP26    SB4    CFSEW
          SX6    PSPTEW*PTCYEW-SPSCEW  PHYSICAL SECTORS PER CYLINDER
          SX5    PSPTEW
          EQ     CLP12       ENTER COMMON 9853/583X/47444 ALGORITHM
 
 
*         TCLP - TABLE FOR CONVERTING LOGICAL TO PHYSICAL ADDRESSES.
 
 TCLP     BSS    0
          LOC    AIDB
 
+         EQ     CLP3        *DB* DEVICES
          ERRNZ  *-AIDB      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP4        *DC* DEVICES
          ERRNZ  *-AIDC      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP5        *DV* AND *DW* DEVICES
          ERRNZ  *-AIDV      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP5        *DV* AND *DW* DEVICES
          ERRNZ  *-AIDW      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP9        *DF* DEVICES
          ERRNZ  *-AIDF      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP10       *DH* DEVICES
          ERRNZ  *-AIDH      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP11       *DN* DEVICES
          ERRNZ  *-AIDN      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP13       *EA* DEVICES
          ERRNZ  *-AIEA      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP14       *EB* DEVICES
          ERRNZ  *-AIEB      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP15       *EC/ED* DEVICES
          ERRNZ  *-AIEC      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP16       *EE/EF* DEVICES
          ERRNZ  *-AIEE      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP17       *EM* DEVICES
          ERRNZ  *-AIEM      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP18       *EN* DEVICES
          ERRNZ  *-AIEN      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP19       *EG/EH* DEVICES
          ERRNZ  *-AIEG      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP20       *EI/EJ* DEVICES
          ERRNZ  *-AIEI      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP21       *EK* DEVICES
          ERRNZ  *-AIEK      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP22       *EL* DEVICES
          ERRNZ  *-AIEL      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP23       *EO/EP* DEVICES
          ERRNZ  *-AIEO      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP24       *ES/EU* DEVICES
          ERRNZ  *-AIES      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP25       *EV* DEVICES
          ERRNZ  *-AIEV      INDEX MUST MATCH POSITION IN TABLE
 
+         EQ     CLP26       *EW* DEVICES
          ERRNZ  *-AIEW      INDEX MUST MATCH POSITION IN TABLE
 
          LOC    *O
 DCB      SPACE  4,15
**        DCB - DELINK CONTROL BUFFER FROM LINK.
*
*         ENTRY  (X0) = CONTROL BUFFER INDEX.
*                (X1) = WORD POSITION OF LINK.
*                (B6) = RETURN ADDRESS.
*
*         EXIT   (X6) = BASE ADDRESS OF CONTROL BUFFERS + OFFSET.
*                (X5) = LINK WORD.
*                (X4) = FORWARD LINK INDEX.
*                (X3) = BACKWARD LINK INDEX.
*                (A7) = ADDRESS OF LINK WORD
*
*         USES   A - 2.
*                X - 1, 2, 3, 4, 5, 6, 7.
 
 
 DCB      BSS    0           ENTRY
          TX6    X1,CBT      FORM BASE ADDRESS + WORD POSITION
          BX1    X0          FORM ADDRESS OF CONTROL BUFFER
          LX1    CBTLS
          IX1    X1+X6
          SA2    X1
          MX1    12          GET FORWARD LINK INDEX
          BX5    X2
          LX1    36
          BX4    X1*X5
          LX1    12          GET BACKWARD LINK INDEX
          BX3    X1*X5
          AX3    36
          ZR     X3,DCB1     IF BACKWARD LINK IS ZERO
          BX7    X3          FORM ADDRESS OF BACKWARD BUFFER
          LX7    CBTLS
          IX7    X7+X6
          LX1    48
+         SA2    X7          **** PERFORM IN ONE WORD ****
          BX2    -X1*X2      **** PERFORM IN ONE WORD ****
          BX7    X2+X4       **** PERFORM IN ONE WORD ****
          SA7    A2          **** PERFORM IN ONE WORD ****
 DCB1     ZR     X4,DCB2     IF FORWARD LINK IS ZERO
          MX1    12
          AX4    24-CBTLS
          IX7    X4+X6
          LX1    48          MODIFY BACKWARD LINK IN FORWARD BUFFER
          LX3    36
+         SA2    X7          **** PERFORM IN ONE WORD ****
          BX2    -X1*X2      **** PERFORM IN ONE WORD ****
          BX7    X2+X3       **** PERFORM IN ONE WORD ****
          SA7    A2          **** PERFORM IN ONE WORD ****
          AX4    CBTLS
          LX3    24
 DCB2     BX1    X0          CLEAR LINK BYTES
          LX1    CBTLS
          IX1    X1+X6
          MX5    36
+         SA2    X1          **** PERFORM IN ONE WORD ****
          LX5    24          **** PERFORM IN ONE WORD ****
          BX7    X5*X2       **** PERFORM IN ONE WORD ****
          SA7    A2          **** PERFORM IN ONE WORD ****
          BX5    X7          LINK WORD
          JP     B6          RETURN
 DCC      SPACE  4,15
**        DCC - DELINK CONTROL BUFFER FROM CONTROL BUFFER LINK.
*
*         ENTRY  (X0) = CONTROL BUFFER ORDINAL.
*                (B3) = REGISTER SAVE BUFFER ADDRESS.
*                (B6) = RETURN ADDRESS.
*
*         EXIT   (X7) PRESERVED.
*
*         USES   A - 1, 2, 7.
*                B - 6.
*                X - 1, 2, 5, 7.
*
*         CALLS  DCB.
 
 
 DCC      BSS    0           ENTRY
          SA7    B3+B1       SAVE (X7)
          SB3    A7+B1
          SX7    B6+         SAVE (B6)
          SA7    A7-B1
          SX1    LSLK        SET CONTROL BUFFER LINK WORD
          BX7    X0          SET CONTROL BUFFER INTERLOCK
          SA7    INLB
          SB6    DCC2        SET RETURN ADDRESS
          EQ     DCB         DELINK BUFFER
 
 DCC2     BX1    X0          GET LIST INDEX WORD
          LX1    CBTLS
          IX1    X1+X6
          MX2    -3
          SA1    X1-LSLK+HSLK
          BX5    X1
          AX5    21          GET LIST INDEX
          BX1    -X2*X5
          TA2    X1,BLMB
          MX7    1           DECREMENT COUNT
          LX7    37
          IX7    X2-X7
          NZ     X3,DCC3     IF BACKWARD LINK NOT ZERO
          MX5    -18         MODIFY FORWARD POINTER
          BX7    X5*X7
          BX7    X7+X4
 DCC3     NZ     X4,DCC4     IF FORWARD LINK NOT ZERO
          MX5    -18         MODIFY BACKWARD POINTER
          LX5    18
          BX7    X5*X7
          LX3    18
          BX7    X7+X3
 DCC4     SA7    A2
          SA1    B3-B1       RESTORE (X7)
          SA2    A1-B1       RESTORE (B6)
          SB3    A1-B1
          BX7    X1
          SB6    X2
          JP     B6          RETURN
 DCH      SPACE  4,15
**        DCH - DELINK CONTROL BUFFER FROM HASH LINK.
*
*         ENTRY  (X0) = CONTROL BUFFER ORDINAL.
*                (B3) = REGISTER SAVE BUFFER ADDRESS.
*                (B6) = RETURN ADDRESS.
*
*         EXIT   (X7) PRESERVED.
*                TO */PROGRAM/HNG* IF NO HASH INDEX OR *PUT* ORDINAL
*                  PRESENT.
*
*         USES   A - 1, 2, 3, 7.
*                B - 6.
*                X - 1, 2, 3, 5, 7.
*
*         CALLS  DCB.
 
 
 DCH      BSS    0           ENTRY
          SA7    B3+B1       SAVE (X7)
          SB3    A7+B1
          SX7    B6          SAVE (B6)
          SA7    A7-B1
          SX1    HSLK        SET HASH CHAIN WORD
          SB6    DCH2        SET RETURN ADDRESS
          EQ     DCB         DELINK BUFFER
 
 DCH2     MX7    39
          SA1    A7+FSTC-HSLK  GET FST INFORMATION
          BX7    X7*X5
          SA7    A7          CLEAR HASH INDEX AND *PUT* ORDINAL
          SX7    B0
          SA7    A1          CLEAR FST INFORMATION
          LX1    -48
          MX7    -12
          NZ     X3,RXR      IF HASH ENTRY UPDATE NOT NEEDED
          BX1    -X7*X1      EST ORDINAL
          MX7    -9
          LX7    12
          BX3    -X7*X5      GET HASH ENTRY INDEX
          LX3    -12
          CX7    X1,EST      CONVERT ORDINAL TO OFFSET
          TA1    X7+EQAE,EST GET PARTITION NUMBER
          MX7    -4
          LX1    -18
          MX2    -12
          BX7    -X7*X1
          SX1    HATLE
          IX7    X1*X7       HASH TABLE PARTITION OFFSET
          BX1    -X2*X5      GET *PUT* ORDINAL
          LX1    PUTLS
          TA1    X1+HSCT,PUT
          IX3    X3+X7       ADJUST HASH TABLE INDEX FOR PARTITION
          AX1    24
          MX2    -18
          BX7    X4
          BX1    -X2*X1
          IX1    X1+X3       FORM HASH ENTRY ADDRESS
          ZR     X4,DCH3     IF HASH ENTRY TO BE ZEROED
          SA3    X1          READ HASH ENTRY
          MX2    -12         MODIFY CONTROL BUFFER INDEX
          BX3    X2*X3
          BX7    X3+X4
 DCH3     SA7    X1          REWRITE HASH ENTRY
          SA1    B3-B1       RESTORE (X7)
          SA2    A1-B1       RESTORE (B6)
          SB3    A1-B1
          BX7    X1
          SB6    X2
          JP     B6          RETURN
 LCB      SPACE  4,15
**        LCB - LINK CONTROL BUFFER.
*
*         ENTRY  (X0) = NEW BUFFER INDEX.
*                (X1) = 24/0 ,18/BI ,18/OI .
*                       BI - OLD BUFFER INDEX.
*                       OI - OFFSET INDEX OF LINK (6,7).
*                (B6) = RETURN ADDRESS.
*
*         USES   A - 2, 3, 7.
*                X - 1, 2, 3, 4, 5, 6, 7.
 
 
 LCB      BSS    0           ENTRY
          TX6    X1,CBT      READ OFFSET
          AX1    18          GET OLD BUFFER INDEX
          BX2    X1          FORM ADDRESS OF OLD BUFFER
          LX2    CBTLS
          IX2    X2+X6
          SA3    X2          READ LINK WORD
          MX4    12          SAVE OLD FORWARD LINK
          LX4    36
          BX3    X4*X3
          AX3    24
          LX0    24          SET FORWARD LINK TO NEW BUFFER INDEX
+         SA2    A3          **** PERFORM IN ONE WORD ****
          BX7    -X4*X2      **** PERFORM IN ONE WORD ****
          BX7    X7+X0       **** PERFORM IN ONE WORD ****
          SA7    A2          **** PERFORM IN ONE WORD ****
          LX0    36
          BX2    X0          GET LINK WORD IN NEW BUFFER
          LX2    CBTLS
          IX2    X2+X6
          SA2    X2
          BX5    X1          SET BACKWARD LINK TO OLD BUFFER
          LX5    12
          BX5    X5+X3       SET FORWARD LINK TO OLD FORWARD
          LX5    24
          MX4    24
          LX4    48
          BX7    -X4*X2
          BX7    X7+X5
          SA7    A2
          ZR     X3,/MONITOR/RB6  IF ADDING TO END OF CHAIN
          BX2    X3          FORM ADDRESS OF FORWARD
          LX2    CBTLS
          IX2    X2+X6
          MX4    12          MODIFY BACKWARD LINK
          LX0    36
          LX4    48
+         SA3    X2          **** PERFORM IN ONE WORD ****
          BX3    -X4*X3      **** PERFORM IN ONE WORD ****
          BX7    X3+X0       **** PERFORM IN ONE WORD ****
          SA7    A3          **** PERFORM IN ONE WORD ****
          LX0    24
          JP     B6          RETURN
 LCC      SPACE  4,15
**        LCC - LINK CONTROL BUFFER TO END OF SPECIFIED CHAIN.
*
*         EXTRY  (X0) = CONTROL BUFFER ORDINAL.
*                (X1) = LIST ADDRESS.
*                (B3) = REGISTER SAVE BUFFER ADDRESS.
*                (B6) = RETURN ADDRESS.
*
*         EXIT   (X7) PRESERVED.
*
*         USES   A - 2, 3, 6, 7.
*                B - 6.
*                X - 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  LCB, RXR.
 
 
 LCC      BSS    0           ENTRY
          SA7    B3+B1       SAVE (X7)
          SB3    A7+B1
          SX7    B6          SAVE (B6)
          SA7    A7-B1
          BX7    X0          SET CONTROL BUFFER INTERLOCK
          SA7    INLB
          BX3    X0          SET NEW LIST INDEX
          LX3    CBTLS
          TA3    X3+HSLK,CBT
          MX4    3
          LX4    24
          BX3    -X4*X3
          TX4    X1,-BLMB
          LX4    21
          BX7    X3+X4
          SA2    X1          READ LIST WORD
          SA7    A3
          NZ     X2,LCC2     IF LIST NOT EMPTY
          SX2    B1          SET COUNT = 1
          LX2    18
          BX2    X2+X0       SET LAST
          LX2    18
          BX7    X2+X0       SET FIRST = LAST
          SA7    A2
          BX1    X0          GET ADDRESS OF CONTROL BUFFER WORD 7
          LX1    CBTLS
          SA2    A3+LSLK-HSLK  READ CONTROL BUFFER LINK WORD
          MX3    24
          LX3    48          ZERO CONTROL BUFFER LINKS
          BX7    -X3*X2
          SA7    A2
          SA1    B3-B1       RESTORE (X7)
          SB3    A1-B1
          SA2    A1-B1       RESTORE (B6)
          BX7    X1
          SB6    X2
          JP     B6          RETURN
 
 LCC2     SX3    B1          INCREMENT COUNT
          LX3    36
          IX2    X3+X2
          MX3    -18         UPDATE LAST POINTER
          LX3    18
          BX1    -X3*X2      SAVE OLD LAST
          SX5    LSLK        ADD CONTROL BUFFER LINK WORD
          IX1    X1+X5
          BX2    X3*X2
          LX0    18
          BX6    X2+X0
          SA6    A2
          LX0    42
          SB6    RXR         SET RETURN ADDRESS TO RESTORE ROUTINE
          EQ     LCB         LINK CONTROL BUFFER (X0) FOLLOWING (X1)
 LCH      SPACE  4,15
**        LCH - LINK CONTROL BUFFER TO HASH CHAIN.
*
*         ENTRY  (X0) = CONTROL BUFFER INDEX.
*                (X1) = HASH ENTRY ADDRESS.
*                (B3) =  REGISTER SAVE BUFFER ADDRESS.
*                (B6) = RETURN ADDRESS.
*
*         EXIT   (X7) PRESERVED.
*
*         USES   A - 1, 2, 3, 4, 7.
*                B - 6.
*                X - 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  LCB, RXR.
 
 
 LCH      BSS    0           ENTRY
          SA7    B3+B1       SAVE (X7)
          SB3    A7+B1
          SX7    B6          SAVE (B6)
          SA7    A7-B1
          BX2    X1
          BX1    X0          SET NEW *PUT* ORDINAL AND HASH INDEX
          SA4    PUTO
          LX1    CBTLS
          TA3    X1+HSLK,CBT
          MX5    -21
          BX3    X5*X3
          SX4    X4+
          BX3    X3+X4
          SA4    HTA         FORM HASH INDEX
          IX4    X2-X4
          LX4    12
          BX7    X3+X4
          MX5    -12
          SA1    X2          GET CONTROL BUFFER INDEX
          MX6    24
          SA7    A3
          LX6    -12         POSITION ADDRESS MASK
          BX1    -X5*X1
          SX3    X0
          ZR     X1,LCH5     IF NO BUFFERS ON HASH THREAD
          LX3    CBTLS
          BX4    X1
          TA3    X3+PAD1,CBT GET DISK ADDRESS FROM NEW BUFFER
          NO
          BX7    X6*X3       EXTRACT CYLINDER, TRACK AND SECTOR
 
*         FIND POSITION TO INSERT NEW BUFFER.
 
 LCH2     BX3    X4          SET BUFFER ORDINAL
          SX1    X4+0
          LX3    CBTLS
          TA4    X3+PAD1,CBT
          BX4    X6*X4       ISOLATE CYLINDER, TRACK AND SECTOR
          IX4    X4-X7
          NG     X4,LCH4     IF POSITION FOUND
          SA4    A4+HSLK     GET FORWARD LINK
          AX4    24
          BX4    -X5*X4
          NZ     X4,LCH2     IF NOT END OF CHAIN
 
 LCH3     SX2    HSLK        FORM PARAMETER FOR *LCB*
          SB6    RXR         RETURN TO RESTORE REGISTERS
          LX1    18
          BX1    X1+X2
          EQ     LCB         LINK CONTROL BUFFER
 
 LCH4     TA4    X3+HSLK,CBT GET BACKWARD LINK
          AX4    36
          BX1    -X5*X4
          NZ     X1,LCH3     IF NOT FIRST BUFFER ON HASH LIST
 
*         UPDATE HASH ENTRY AND ADD BUFFER AT START.
 
 LCH5     SA1    X2          READ HASH ENTRY
          BX4    -X5*X1
          BX1    X5*X1       SET INDEX = NEW BUFFER
          BX7    X1+X0
          SA7    A1
          LX0    CBTLS       READ HASH CHAIN WORD OF NEW BUFFER
          TA2    X0+HSLK,CBT
          BX2    -X6*X2
          LX4    24          SET FORWARD LINK = OLD HASH INDEX
          BX7    X2+X4
          LX4    36+CBTLS    POSITION HASH INDEX
          SA7    A2
          LX0    -CBTLS
          ZR     X4,RXR      IF NO BUFFERS ON CHAIN
          TA2    X4+HSLK,CBT
          LX5    36
          BX2    X5*X2       SET BACKWARD LINK = NEW BUFFER
          LX0    36
          BX7    X2+X0
          LX0    24
          SA7    A2
*         EQ     RXR         RESTORE (X2) AND (X7) AND RETURN
          ERRNZ  *-RXR       *RXR* MUST FOLLOW *LCH*
 RXR      SPACE  4,15
**        RXR - RESTORE X2 AND X7 AND EXIT TO (X2).
*
*         ENTRY  (B3) = NEXT AVAILABLE SCRATCH.
*
*         EXIT   REGISTERS X2 AND X7 ARE RESTORED.
*                (B6) RESTORED TO RETURN ADDRESS.
*                RETURN IS TO (X2), NOT TO CALLER.
*                (B3) UPDATED.
*
*         USES   A - 1, 2.
*                B - 3, 6.
*                X - 1, 2, 7.
 
 
 RXR      BSS    0           ENTRY
          SA1    B3-B1       RESTORE (X7)
          SB3    A1-B1
          SA2    A1-B1       RESTORE (X2)
          BX7    X1
          SB6    X2          GET RETURN ADDRESS
          JP     B6          RETURN
 SBB      SPACE  4,10
**        SBB - SET BUFFER BUSY RESPONSE.
*
*         EXIT   (X6) = 1/0, 1/1, 58/0   (BUSY STATUS).
*                PUT STATISTICS UPDATED.
*                CONTROL PASSED TO LBMXS.
*
*         USES   A - 1, 3, 6.
*                X - 1, 3, 4, 6.
 
 
 SBB      BSS    0           ENTRY
          SA3    PUTO
          SX6    B1
          LX3    PUTLS
          TA1    X3+ACRJ,PUT COUNT BUFFER BUSY
          BX3    X1
          LX1    59-23
          NG     X1,SBB1     IF OVERFLOW
          IX7    X3+X6
          SA7    A1
 SBB1     SA1    A1+B1
          ERRNZ  ACST-ACRJ-1 CODE DEPENDS ON VALUE
          BX3    X1
          LX1    59-35
          IX7    X3+X6
          NG     X1,SBB2     IF OVERFLOW
          SA7    A1+
 SBB2     LX6    58-0        SET BUSY STATUS
          EQ     LBMXS       EXIT TO LBM
 SIS      SPACE  4,10
**        SIS - SET INACCESSIBLE DEVICE RESPONSE.
*
*         EXIT   TO *LBMXS* WITH DEVICE INACCESSIBLE STATUS.
*
*         USES   X - 6.
 
 
 SIS      BSS    0           ENTRY
          SX6    B1
          LX6    56-0
          EQ     LBMXS       EXIT BUFFER MANAGER
 SNS      SPACE  4,20
**        SNS - SET NEXT SECTOR.
*
*         ENTRY  (LSEC) = CURRENT LOGICAL SECTOR.
*                (LTRK) = CURRENT LOGICAL TRACK.
*                (MSTA) = MST ADDRESS.
*                (B3) = REGISTER SAVE BUFFER ADDRESS.
*                (B6) = RETURN ADDRESS.
*
*         EXIT   (X0) = NON-ZERO  IF END OF LOGICAL TRACK CHAIN.
*                (X7) PRESERVED.
*                (LSEC) UPDATED.
*                (LTRK) UPDATED.
*
*         USES   A - 1, 2, 6, 7.
*                B - 6.
*                X - 0, 1, 2, 6.
*
*         CALLS  RXR.
 
 
 SNS      BSS    0           ENTRY
          SA7    B3+B1       SAVE (X7)
          SB3    A7+B1
          SX7    B6          SAVE (B6)
          SA7    A7-B1
          SA1    LSEC
          SX2    LSLB
          IX6    X1+X2
          SA6    A1
          SA1    LTRK
          BX0    X1          (X0) = CURRENT LOGICAL TRACK
          SA1    MSTA
          MX2    -2
          BX2    -X2*X0      TRT BYTE INDEX
          LX2    2
          SB6    X2
          LX2    1
          SB6    X2+B6       BYTE INDEX*12D
          MX2    -9
          LX0    -2
          BX7    -X2*X0      TRT WORD INDEX
          SA2    X1+TRLL
          IX7    X2+X7
          SA2    X7          READ TRT WORD
          LX2    B6
          MX7    12
          SX0    B0          CLEAR EOI FLAG
          BX7    X7*X2       NEXT TRACK
          NG     X7,SNS1     IF CURRENT IS NOT EOI TRACK
          LX7    12
          IX2    X6-X7
          NG     X2,RXR      IF NEW BUFFER NOT BEYOND EOI
          ZR     X2,RXR      IF EOI IN NEW BUFFER
          SX0    B1          SET EOI FLAG
          EQ     RXR         EXIT
 
 SNS1     SA1    X1+MDGL     SECTOR LIMIT
          MX2    -12
          BX1    -X2*X1
          IX2    X6-X1
          NG     X2,RXR      IF NOT AT SECTOR LIMIT
          LX7    12
          SA7    LTRK        SET NEXT TRACK
          LX7    59-11
          MX6    0
          SA6    LSEC        RESET LOGICAL SECTOR
          EQ     RXR         RESTORE X2 AND X7 AND RETURN TO (X2)
 SNT      SPACE  4,15
**        SNT - SET NEXT TRACK.
*
*         ENTRY  (X0) = CURRENT LOGICAL TRACK.
*                (X1) = MST ADDRESS.
*                (B6) = RETURN ADDRESS.
*
*         EXIT   (X6) = NEW LOGICAL TRACK.
*                (X2) = TRT WORD WITH NEXT TRACK IN BITS 48-59.
*
*         USES   A - 2.
*                X - 2, 6.
 
 
 SNT      BSS    0           ENTRY
          MX2    -2
          BX2    -X2*X0      BYTE INDEX
          SB1    B6          SAVE (B6)
          LX2    2
          SB6    X2
          LX2    1
          SB6    X2+B6       BYTE INDEX * 12D
          MX2    -9
          LX0    -2
          BX6    -X2*X0
          SA2    X1+TRLL
          IX6    X2+X6
          SA2    X6          READ TRT WORD
          LX2    B6
          SB6    B1          RESTORE (B6)
          SB1    1           RESTORE (B1)
          MX6    12
          LX0    2
          BX6    X6*X2       GET NEXT TRACK POINTER
          LX6    12
          JP     B6          RETURN
 SRC      SPACE  4,10
**        SRC - SET RECALL CONTROL.
*
*         ENTRY  (B6) = RETURN ADDRESS.
*                (X0) = CONTROL BUFFER INDEX.
*
*         USES   A - 1, 3, 6.
*                X - 1, 2, 3, 4, 6.
 
 
 SRC      BSS    0           ENTRY
          BX2    X0          GET CONTROL BUFFER ADDRESS
          LX2    CBTLS
          TA3    X2+LSLK,CBT GET RECALL WORD
          SA1    RPRM        GET RECALL PARAMETER
          MX4    -24         SET RECALL CONTROL
          BX3    X4*X3
          BX6    X3+X1
          SA6    A3
          JP     B6          RETURN
 SRR      SPACE  4,10
**        SRR - SET RECALL RESPONSE.
*
*         EXIT   (X6) = 1/1, 59/0   (RECALL STATUS).
*                PUT STATISTICS UPDATED.
*                CONTROL PASSED TO *LBMXS*.
*
*         USES   A - 1, 3, 6.
*                X - 1, 3, 4, 6.
 
 
 SRR      BSS    0           ENTRY
          SA3    PUTO
          SX4    B1
          LX3    PUTLS
          MX6    1
          TA1    X3+ACST,PUT COUNT BUFFER PROCESSED AND RECALLED
          LX4    35-0
          BX6    -X1*X6
          BX4    -X1*X4
          LX6    36-59
          LX4    0-35
          BX6    X6+X4
          IX6    X1+X6
          SA6    A1
          MX6    1           SET RECALL STATUS
          EQ     LBMXS       EXIT
          TITLE  CIO MONITOR MODE ROUTINES.
 CPP      SPACE  4,10
**        CPUCIO (PSEUDO-PP) EXCHANGE PACKAGE.
*
*         CONTAINS 20-WORD EXCHANGE PACKAGE SIMILAR TO
*         THE ONE AT CONTROL POINT N+1, AND THREE EXTRA WORDS
*         TO MAKE UP A SHORT CONTROL POINT AREA.
 
 
 CPP      EXP    P=/BUFIO/PPC,FL=(,MCM),RAX=(,RXX),FLX=(,MEC),B1=1,A5=(1
,,SP),MA=CPP,EM=(,CXPFE),EA=CPP
 
*         *STSW*.
 
          VFD    3/ZCPS      NULL CPU STATUS
          VFD    57/0
 
*         CWQW.
 
          VFD    2/1
          VFD    7/MTCS      CPU PRIORITY = *MAGNET-S*
          VFD    1/0
          VFD    1/0         CPU SLICE ACTIVE
          VFD    1/0         RECALL FLAG
          VFD    1/1         EXTENDED CPU SLICE INCOMPLETE
          VFD    2/0
          VFD    9/0         SERVICE CYCLE
          VFD    9/SSSC*JCBE  SERVICE PARAMETERS INDEX
          VFD    1/0         *MTR* BYPASS FLAG
          VFD    2/1         SELECT CPU 0
          VFD    3/0
          VFD    3/PSXT      PSEUDO-PP EXCHANGE PACKAGE TYPE
          VFD    18/0        *WQ* LINKAGE
 
*         CSAW.
 
          VFD    60/0
 
*         *CTMW*.
 
          VFD    60/0
 ACQ      SPACE  4,15
**        ACQ - ASSIGN PSEUDO-PP OR CPUCIO REQUEST QUEUE.
*
*         ENTRY  (X6) = REQUEST.
*                (B3) = NORMAL EXIT ADDRESS.
*                (B4) = EXIT ADDRESS IF NON-ASSIGNABLE REQUEST
*                (B7) = CONTROL POINT AREA ADDRESS.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 3, 6.
*
*         CALLS  /MONITOR/AQR, /MONITOR/RCC.
 
 
 ACQ      TA2    SP
          NZ     X2,ACQ1     IF PSEUDO-PP NOT AVAILABLE
 
*         TO INTERLOCK WITH *MTR*, *ACPP* AND THE PP COUNT MUST BE
*         UPDATED BEFORE THE STORAGE MOVE CHECK.
 
          SA1    B7+STSW
          SX2    B7
          SX7    B7          SET CP ADDRESS FOR MONITOR FUNCTIONS
          LX2    24          SET ASSIGNED CP ADDRESS
          SX0    B1
          BX7    X7+X2
          LX2    24-7        SET CP NUMBER
          LX0    48
          BX7    X7+X2
          TA7    ACPP,SPX    SET CP ASSIGNMENT
          IX7    X1+X0       INCREMENT PP COUNT
          SA7    A1
          SA4    CMCL        GET MOVE CONTROL
          MX0    55
          LX2    -12
          LX0    36
          BX6    X0*X6
          BX6    X6+X2       SET CP NUMBER IN IR
          LX2    12
          BX7    X4-X2
          AX7    48
          ZR     X7,ACQ0.1   IF STORAGE MOVE REQUESTED / IN PROGRESS
          SA6    A2+         SET PSEUDO-PP IR
          SA1    /CPUCIO/MB
          BX6    X1
          SA1    A1+B1
          ERRNZ  /CPUCIO/MB1-/CPUCIO/MB-1  ADDR MUST BE CONSECUTIVE
          SA6    A2+2+4      MB TO MB+4
          BX7    X1
          SA1    A1+B1
          ERRNZ  /CPUCIO/MB2-/CPUCIO/MB1-1  ADDR MUST BE CONSECUTIVE
          BX6    X1
          SA6    A6-B1       MB2 TO MB+3
          SB6    CPP         EXCHANGE PACKAGE ADDRESS
          SA7    A6-B1       MB1 TO MB+2
          SX6    B3          SAVE RETURN ADDRESS
          SA6    /MONITOR/T2
          SB3    ACQ0        *RCC* RETURN ADDRESS
          EQ     /MONITOR/RCC  RECALL CPU
 
 ACQ0     SA1    /MONITOR/T2
          SB3    X1+         RESTORE RETURN ADDRESS
          JP     B3          RETURN
 
 ACQ0.1   TA7    ACPP,SPX    CLEAR CP ASSIGNMENT
          BX7    X1          RESTORE PP COUNT
          SA7    A1
 ACQ1     SA3    /CPUCIO/MB  SAVE PARAMETER WORD
          R=     X2,/MONITOR/CQ
          SB3    B4          SET STORAGE MOVE RETURN ADDRESS
          BX7    X3
          SA7    /MONITOR/AQRA
          EQ     /MONITOR/AQR  ASSIGN QUEUE REQUEST
 IPP      SPACE  4,10
**        IPP - INITIATE PSEUDO PP CIO PROCESSOR.
*
*         ENTRY  REFER TO CPUCIO SPECIAL PROCESSORS DOCUMENTATION.
*
*         EXIT   TO */CPUCIO/CPCX* IF STANDARD ASSIGNMENT.
*                TO */IHPFMD/RPP1* OR */IH819/PPE1* IF BUFFER
*                   MANAGER RECALL.
*                TO */CPUCIO/RPC* IF NOT BUFFERED DEVICE
*                   PROCESSOR FUNCTION OR NULL FILE.
*
*         CALLS  ACQ.
 
 
 IPP      BSS    0           ENTRY
          TNO    /BUFIO/IPS,BIOMMF
 IPP0     MX1    -3          GET TERMINATION CONDITION
          LX4    4
          SX2    5714B
          BX1    -X1*X4
          LX4    2
          MX6    1
          BX2    X2*X4
          LX6    55-59
          SX3    X2-/CIO/SKP*100B-/CIO/EOI
          AX2    9
          BX6    X4+X6       SET FUNCTION FLAG
          ZR     X3,/CPUCIO/RPC  IF *SKIPEI*
          MX4    12
          NZ     X2,/CPUCIO/RPC  IF BACKWARD SKIP
          ZR     X1,/CPUCIO/RPC  IF *RPHR*/*WPHR*
          SA6    A4
          ERX1   X0          GET CURRENT TRACK
          LX4    -24
          BX1    X4*X1
          ZR     X1,/CPUCIO/RPC  IF NULL FILE
 IPP1     SA1    /CPUCIO/IR  GET *CIO* CALL
          SB3    IPP2        SET RETURN ADDRESS FOR *ACQ*
          BX6    X1
          SB4    B3
          TJP    (/DCP/ACQ,DCPC,/BUFIO/ACQ)  ASSIGN PSEUDO PP
 
 IPP2     SA1    IPPA        CHECK FOR BUFFER MANAGER RECALL REQUEST
          NG     X1,/CPUCIO/CPCX  IF NOT BUFFER MANAGER RECALL REQUEST
          TEQ    (/IHPFMD/RPP1,IHPFMD,/IH819/PPE1) PROCESS NEXT REQUEST
 
 
 IPPA     CON    -1
 MNR      SPACE  4,10
**        MNR - *BUFIO* EXTENSION TO PROGRAM MODE EXIT PROCESSING.
*
*         EXIT   TO */MONITOR/PPE*  IF *FLPP* INTERRUPT.
*                TO */BUFIO/IOC*    IF BUFFER MANAGER REQUEST PRESENT.
*                TO */MONITOR/MNR4* IF NONE FOUND (X0 = 0).
 
 
 MNR      SA1    B2+3        GET *PSD* FROM EXCHANGE PACKAGE
          TA2    IORQ        I/O REQUESTS
          BX0    X0-X0
          LX1    59-39       POSITION TO STEP MODE FLAG
          NZ     X2,IOC      IF I/O REQUEST PROCESSED
          TNG    X1,(/MONITOR/PPE,IH819,/BUFIO/MNR)  IF INTERRUPT
          EQ     /MONITOR/MNR4  RETURN TO MAIN ROUTINE
 
*         EXTENSION FOR PSEUDO-PP REQUEST PROCESSING.
*
*         ENTRY  (X3) = MONITOR MODE START TIME.
*
*         EXIT   (A5) = PSEUDO-PP OUTPUT REGISTER ADDRESS.
*                TO */MONITOR/MTRX* IF NO PSEUDO PP REQUEST TO
*                   PROCESS.
*                TO */MONITOR/PPR0.1* IF PSEUDO PP REQUEST TO PROCESS.
*                TO */IH819/PPE* OR */BUFIO/MNR* IF BUFFER MANAGER
*                   RECALL.
*                (B4) = REQUEST IF EXIT TO *PPR0.1*.
*                (X1) = OUTPUT REGISTER BITS 0 - 47 IF EXIT TO
*                       *PPR0.1*.
 
 
 MNR1     SA1    B2+3
          TA5    1,SP        GET PSEUDO-PP OUTPUT REGISTER
          LX1    59-39
          MX0    4
          TNG    X1,(/IH819/PPE,IH819,/BUFIO/MNR1)  IF BUFFER RECALL
          BX0    X0*X5
          NZ     X0,/MONITOR/MTRX  IF REQUEST ALREADY PROCESSED
          UX1    B4,X5
          SB4    B4+1777B
          NZ     B4,/MONITOR/PPR0.1  IF REQUEST OUTSTANDING
          EQ     /MONITOR/MTRX  EXIT
 PCQ      SPACE  4,10
**        PCQ - PROCESS PSEUDO-PP REQUEST QUEUE.
*
*         ENTRY  IF ENTERED AT *PCQ1* -
*                (B3) = RETURN ADDRESS IF PSEUDO-PP NOT AVAILABLE.
*                (B4) = RETURN ADDRESS IF NO OUTSTANDING REQUESTS.
*
*         CALLS  ACQ.
 
 
 PCQ      SB3    /MONITOR/MTRX  *ACQ* RETURN ADDRESS
          SB4    PCQ2
 PCQ1     SA1    CQRL        GET NEXT ENTRY
          TA2    SP
          ZR     X1,/MONITOR/RB4  IF NO PSEUDO-PP REQUESTS
          NZ     X2,/MONITOR/RB3  IF PSEUDO-PP NOT AVAILABLE
          SA4    X1+RECW-RCCW  READ PP REQUEST
          MX7    -12+7       CONTROL POINT ADDRESS MASK
          LX7    7
          BX7    -X7*X1
          SB7    X7          CPA
          SA2    X1          DELETE ENTRY FROM QUEUE
          MX0    -4
          BX6    X2
          SA6    A1
          BX6    X6-X6
          SA1    B7+STSW     ADD RECALL SLOT TO FREE LIST
          SX3    -420B-RCCW+1
          SA6    A4
          BX7    -X0*X1
          BX1    X0*X1
          SX0    A2-B7       COMPUTE RECALL INDEX
          SA7    A2
          IX0    X0+X3
          SA3    A2+REPW-RCCW  GET PARAMETER WORD
          IX7    X0+X1       SET NEW FREE ENTRY AND RECALL COUNT
          SA6    A3+
          BX6    X4
          SA7    A1
          BX7    X3
          SA7    /CPUCIO/MB  SET PARAMETER WORD
          EQ     ACQ         ASSIGN PSEUDO-PP
 
 PCQ2     SA1    CPP+STSW    SET NULL STATUS ON PSEUDO-PP
          MX7    3
          BX6    X7*X1
          ZR     X6,/MONITOR/MTRX  IF PSEUDO-PP NOT ACTIVE
          BX7    -X7*X1
          SA7    A1
          EQ     /MONITOR/BNJ1  BEGIN NEW JOB
 PRQ      SPACE  4,10
**        PRQ - PROCESS REQUEST QUEUE.
*
*         ENTRY  (X1) = BUFFER ORDINAL TO RECALL.
*
*         CALLS  IPP, /CPUCIO/CPC.
 
 
 PRQ      SA2    BQRL        GET FIRST ENTRY
          MX0    12
          LX1    12
          LX0    -36
 PRQ1     SB6    A2
          BX2    -X0*X2
          SX6    X2
          SA2    X2
          ZR     X6,IPP2     IF END OF QUEUE
          BX6    X0*X2
          IX6    X6-X1
          NG     X6,PRQ1     IF BUFFER NUMBER NOT REACHED
          NZ     X6,IPP2     IF NO MATCH
 
*         ENTRY FOUND, DELETE FROM QUEUE AND RESTART.
 
          MX0    -12
          BX6    -X0*X2      EXTRACT LINK
          SA3    B6          GET LAST ENTRY
          BX3    X0*X3       CLEAR OLD LINK
          BX6    X6+X3       INSERT NEW LINK
          SA6    A3
          SA4    A2+RECW-RCCW  READ RECALL REQUEST
          SX1    A2
          AX1    7
          LX1    7
          SB7    X1          CONTROL POINT AREA ADDRESS
          SA1    B7+STSW
          SX0    A2-B7       ADD FREE ENTRY TO CONTROL POINT
          MX2    -4
          SX0    X0-RCCW+1-420B
          BX7    -X2*X1
          BX6    X6-X6
          BX1    X2*X1
          SA7    A2
          SA6    A4+
          SA3    A2+REPW-RCCW  GET PARAMETER WORD
          SA6    A3
          BX6    X3
          SA6    /CPUCIO/MB
          IX7    X1+X0
          BX6    X4
          SA7    A1+
          SA6    /CPUCIO/IR
          TA5    1,FP        SIMULATE *MTR* REQUEST
          EQ     /CPUCIO/CPC PROCESS CIO REQUEST
          TITLE CIO PROCESSOR.
          SPACE  4,10
**        CIO PROCESSOR.
*
*         STANDARD REGISTER DEFINITIONS.
*
*         (B1) = 1.
*         (B7) = CPA.
*         (A4) = (A5) + 5 = MESSAGE BUFFER + 4.
*         (A5) = PSEUDO OUTPUT REGISTER ADDRESS.
*         (X4) = ABSOLUTE FST ADDRESS.
*         (X5) = ABSOLUTE FET+1.
*
*T  IR    18/ *CIO*, 1/A, 5/ CP, 18/ SKIP COUNT, 18/ FET ADDRESS
*
*T  MB    12/ BF5, 12/ BF4, 12/ BF3, 12/ BF2, 12/ BF1
*
*T  MB+1  12/ BF10, 12/ BF9, 12/ BF8, 12/ BF7, 12/ BF6
*
*T  MB+2  12/ 0, 24/ *IN*, 24/ *OUT*
*
*T  MB+3  1/R, 5/0, 6/ FETL, 24/ *FIRST*, 24/ *LIMIT*
*         R      SET IF RANDOM FILE.
*         FETL   FET LENGTH - 5.
*
*         FET PARAMETERS ARE TRANSFERRED ONLY IF CIO REQUEST
*         IS NOT RESTARTED FROM PSUEDO PP BUSY RECALL STACK.
*
*T  MB+4  1/S,5/ RF,6/ RC,5/0,1/F,6/ EC,12/ ORD,4/ LV,8/ XC,12/ IC
*         S      SET IF *CIO* RESTARTED FROM RECALL STACK.
*         RF     RESTART FLAGS = 1/TIF, 1/0, 1/SDT, 1/BDF, 1/DTF.
*                TIF = TRACK INTERLOCK FLAG.
*                SDT = SKIP DATA TRANSFER FLAG.
*                BDF = BUFFERED DEVICE FUNCTION FLAG.
*                DTF = DATA TRANSFERRED FLAG.
*         RC     RECALL STACK REASON CODE.
*         F      BUILD FNT ENTRY (FLAG FOR *1MS* ONLY).
*         EC     ERROR CODE, IF NONZERO.
*         ORD    RELATIVE ADDRESS OF FNT ENTRY IN NFL.
*         LV     LEVEL NUMBER (0 - 17B).
*         XC     EXTERNAL *CIO* FUNCTION CODE.
*         IC     INTERNAL *CIO* FUNCTION CODE (SEE *COMSCIO*).
*
*T  MB+5  1/E, 23/0, 18/ MSTA, 18/ ST
*         E      SET IF WRITE EOI REQUIRED.
*         ST     SECTORS PER TRACK ON EQUIPMENT.
*         MSTA   MST ADDRESS OF EQUIPMENT.
          SPACE  4,10
**        GLOBAL DATA.
 
 
 ABRA     CON    0           ABSOLUTE RA
 CHRV     CON    0           MASS STORAGE CONTROL FLAGS
 CLEA     CON    0           CURRENT READ LIST ENTRY ABSOLUTE ADDRESS
 CWLA     CON    0,0         CONTROL WORD DATA ADDRESS / WORD COUNT
 ERWB     BSS    3           EXTENDED READ/WRITE BUFFER
 FMOD     CON    0           FILE MODE FOR WRITE
 FSZL     CON    0           FILE SIZE LIMIT
 LBIA     CON    0           30/ FIRST SECTOR, 30/ CONTROL BUFFER FWA
 NPCB     CON    0           NUMBER OF PRUS IN *CIO* BUFFER
 NPTR     CON    0           NUMBER OF PRUS TO TRANSFER
 NTKP     CON    0           NEXT TRACK POINTER
 PCMS     CON    0           PRU CHANGE IN MASS STORAGE ALLOCATION
 PRUC     CON    0           PRU COUNT
 PMFF     CON    0           PERMANENT FILE FLAG
 RCEV     EQU    FSZL        RECALL EVENT
 SCIE     EQU    ERWB+1      SECTOR COUNT FROM INITIAL POSITION TO EOI
 SDTW     CON    0           SKIP DATA TRANSFER FLAG FOR WRITE
 STLR     EQU    SDTW        SECTOR/TRACK LINKAGE FOR READ
 USCW     CON    0           UPDATED SECTOR CONTROL WORD FOR WRITE
 WCCB     CON    0           WORD COUNT OF DATA IN *CIO* BUFFER
 WLBR     EQU    SDTW        WRITE I/O BUFFER REQUEST
 
 FCAC     VFD    36/0,8/IMSK,8/IMWT,8/IMRD  FUNCTION CHARGE
 
 FCCM     CON    741774B     FET CODE CLEAR MASK (FOR READ)
 FCSM     CON    20B         FET CODE MASK TO SET EOR
          CON    740030B     FET CODE MASK TO SET EOF
          CON    741030B     FET CODE MASK TO SET EOI
 
 UACC     VFD    12/AISS,12/IOAW,6/40,6/20,24/0  ACCOUNTING UPDATE
 UAMI     VFD    12/CDCS,12/ACLW,6/0,6/18,24/0   *UADM* MS PRU CHANGE
 
 
 TFSL     BSS    0           TABLE OF FILE SIZE LIMITS
          VFD    30/0,30//PFM/DSRNG1*100B
          VFD    30//PFM/DSRNG2*100B,30//PFM/DSRNG3*100B
          VFD    30//PFM/DSRNG4*100B,30//PFM/DSRNG5*100B
          VFD    30//PFM/DSRNG6*100B,30//PFM/DSRNG7*100B
          SPACE  4,10
          ERRNZ  /CIO/RDF    INDEX MUST BE ZERO
          ERRNZ  /CIO/WTF-1  INDEX MUST BE ONE
          ERRNZ  /CIO/SKP-2  INDEX MUST BE TWO
          SPACE  4,10
 RB3      EQU    /MONITOR/RB3  EXIT TO (B3)
 RB4      EQU    /MONITOR/RB4  EXIT TO (B4)
 RB5      EQU    /MONITOR/RB5  EXIT TO (B5)
 RB6      EQU    /MONITOR/RB6  EXIT TO (B6)
          TITLE  CIO PROCESSOR EXIT ROUTINES.
 RCR      SPACE  4,15
**        RCR - REQUEST CIO RECALL.
*
*         ENTRY  (X7) = RECALL REASON CODE.
*                (X6) = I/O BUFFER ORDINAL IF ENTRY AT *RCR3*.
*
*         EXIT   TO *PPCX*.
*
*                A - 0, 1, 2, 3, 6, 7.
*                B - 6.
*                X - 0, 1, 2, 3, 6, 7.
*
*         CALLS  UAC, WEI.
 
 
*         PRU TRANSFER LIMIT.
 
 
 RCR      SX7    PTLR        SET PRU TRANSFER LIMIT REASON CODE
          SX6    -IORT       SET I/O TIME RECALL
          SB6    RCR6        SET TO CALL *WEI*
          EQ     RCR4        SAVE RECALL TIME AND REASON
 
*         REQUEST TRACK REJECT.
 
 RCR1     SX7    TIRR        SET TRACK REJECT REASON CODE
          SX6    -TIRT       SET TRACK REJECT RECALL TIME
          SB6    RCR6        SET TO CALL *WEI*
          EQ     RCR4        SAVE RECALL TIME AND REASON
 
*         I/O BUFFER BUSY.
 
 RCR2     SX7    LBBR        SET I/O BUFFER BUSY REASON CODE
          SX6    -IORT       SET I/O TIME RECALL
          SB6    RCR6        SET TO CALL *WEI*
          EQ     RCR4        SAVE RECALL TIME AND REASON
 
*         I/O BUFFER RECALL.
 
 RCR3     SX7    LBRR        SET I/O BUFFER RECALL REASON CODE
          SB6    RCR6        SET TO CALL *WEI*
 RCR4     LX6    24
          SA2    A4          SET RECALL STACK REASON CODE
          SA6    RCEV        SAVE RECALL TIME/EVENT
          MX1    6
          LX1    -6
          BX1    -X1*X2
          LX7    -12
          BX7    X7+X1
          SA7    A4
          JP     B6          COMPLETE PROCESSING FOR RECALL
 
*         SET/CLEAR TRACK INTERLOCK REJECT.
 
 RCR5     SX7    TIRR        SET TRACK INTERLOCK REJECT
          SX6    -TIRT       SET TRACK INTERLOCK REJECT TIME
          SB6    RCR8        SET TO ENTER RECALL STACK
          EQ     RCR4        SAVE RECALL TIME AND REASON
 
*         WRITE EOI IF NECESSARY.  RELEASE I/O BUFFER INTERLOCKS.
 
 RCR6     SA0    RCR7        SET RETURN ADDRESS FOR *WEI*
          EQ     WEI         WRITE EOI/RELEASE BUFFER INTERLOCKS
 
*         UPDATE ACCOUNTING.  CLEAR TRACK INTERLOCK.
 
 RCR7     SA0    RCR8        SET RETURN ADDRESS FOR *UAC*
          SX7    B1          SET TO NOT RECALL CPU
          SB6    A0          RETURN ADDRESS IF TRACK INTERLOCK REJECT
          EQ     UAC         UPDATE ACCOUNTING
 
*         ENTER RECALL STACK.
 
 RCR8     SA1    A5-B1       GET *CIO* CALL
          SX0    B1+
          BX6    X1
          SA2    A4          GET MESSAGE BUFFER PARAMETERS
          SA6    A5+B1
          SX6    PBMF        SET I/O BUFFER RECALL EVENT
          BX7    X2
          SA3    RCEV        GET RECALL TIME/EVENT
          SA7    A6+B1
          BX6    X6+X3
          LX2    0-58
          SX1    RECM        SET TO ENTER RECALL STACK
          PL     X3,PPCX     IF I/O BUFFER RECALL
          SX6    PBMF        SET I/O BUFFER RECALL EVENT
          BX6    -X3+X6
          BX2    X2*X0       TRACK INTERLOCK RESTART FLAG
          IX6    X6-X0       SET TIMED RECALL
          ERRNZ  PBMF-PTMF-1 INDEXES MUST BE CONSECUTIVE
          IX6    X6-X2       SET TIMED RECALL / NO ROLLOUT
          ERRNZ  PTMF-PTRF-1 INDEXES MUST BE CONSECUTIVE
          EQ     PPCX        EXIT
 RPC      SPACE  4,10
**        RPC - REQUEST PP CIO.
*
*         ENTRY  (X7) = ERROR CODE, IF NONZERO.
*                (X0) = RA IF ENTRY AT *RPC3*.
*
*         EXIT   TO *PPCX*.
*
*         ERROR  TO *RCR5* IF TRACK INTERLOCK CLEAR REJECT.
*
*         USES   A - 0, 1, 2, 6, 7.
*                B - 6.
*                X - 1, 2, 3, 5, 6, 7.
*
*         CALLS  UAC, WEI.
 
 
 RPC3     SA2    A5+5        CALCULATE FST ADDRESS
          MX6    -12
          LX2    -24
          BX6    -X6*X2
          IX6    X0-X6
          R=     X4,FSTL
          IX4    X6+X4       ABSOLUTE FST ADDRESS
*         EQ     RPC         BUILD PP REQUEST
 
 RPC      SA2    A4          SET ERROR CODE
          LX7    36
          SA1    A5-B1       GET *CIO* CALL
          MX6    -59
          BX7    X7+X2
          MX3    -42
          SX2    3R1MS       CHANGE TO *1MS* CALL
          BX7    -X6*X7      CLEAR RECALL STACK FLAG
          LX2    -18
          BX6    -X3*X1
          SA7    A4
          BX6    X6+X2
          SA6    A5-B1
          SA0    RPC1        SET RETURN ADDRESS FOR *WEI*
          BX6    X3*X1
          BX6    X6-X2
          NZ     X6,WEI      IF *WEI* NOT YET CALLED
 RPC1     SA0    RPC2        SET RETURN ADDRESS FOR *UAC*
          SB6    RCR5        RETURN ADDRESS IF TRACK INTERLOCK REJECT
          SX7    B1          SET NO RECALL OF CPU
          EQ     UAC         UPDATE ACCOUNTING
 
 RPC2     SA1    A5-B1       GET *CIO* CALL
          SA2    A4          GET MESSAGE BUFFER PARAMETERS
          BX6    X1
          LX7    X2
          SA6    A5+B1
          SX1    RPPM        REQUEST PP
          SA7    A6+B1
          SX6    B1+B1       SET NO REJECT ON PP CALL
          EQ     PPCX        EXIT
 CMP      SPACE  4,15
**        CMP - COMPLETE MASS STORAGE PROCESSING.
*
*         ENTRY  (B2) = FET STATUS FOR READ/SKIP.
*
*         EXIT   TO *PPCX*.
*
*         ERROR  TO *RCR5* IF TRACK INTERLOCK CLEAR REJECT.
*
*         USES   A - 0, 1, 2, 3, 6, 7.
*                B - 4, 6.
*                X - 1, 2, 3, 6, 7.
*
*         CALLS  UAC, WEI.
 
 
 CMP5     SA1    SSTL
          LX1    59-16
          NG     X1,CMP      IF *CIO* LOGGING DISABLED
          SA2    A4          GET MESSAGE BUFFER PARAMETERS
          LX2    59-54
          SX7    /CIOERR/UCF *UNNECESSARY CIO FUNCTION*
          PL     X2,RPC      IF NO DATA PREVIOUSLY TRANSFERRED
*         EQ     CMP         COMPLETE FUNCTION
 
 CMP      SA2    A4          GET MESSAGE BUFFER PARAMETERS
          SA0    CMP2        SET RETURN ADDRESS FOR *WEI*
          LX2    59-6
          NG     X2,WEI      IF WRITE
          ZR     B2,WEI      IF NOT EOR/EOF/EOI
          SX1    B2
          AX1    2
          SA1    FCSM-1+X1   GET CODE SET MASK
          LX2    59-7-59+6
          SX3    B1          GET FET+0
          IX7    X5-X3
          ERX3   X7
          NG     X2,CMP1     IF SKIP
          SA2    FCCM        GET CODE CLEAR MASK
          BX3    -X2*X3
 CMP1     BX6    X3+X1
          EWX6   X7
          EQ     WEI         RELEASE BUFFER INTERLOCK
 
*         CHARGE FOR *CIO* OPERATION.
 
 CMP2     SA2    A4          GET MESSAGE BUFFER PARAMETERS
          MX6    48
          BX6    X6*X2
          LX2    -6
          MX1    -4
          BX1    -X1*X2
          SA6    A4
          LX1    3
          SB4    X1
          SA1    FCAC        GET FUNCTION CHARGES
          AX1    B4
          MX6    -8
          BX6    -X6*X1
          SA1    UACC        INCREMENT ACCOUNTING
          IX6    X6+X1
          LX2    59-6+6
          MX7    1
          SA6    A1
          PL     X2,CMP3     IF NOT WRITE
          SA1    PRUC        GET PRU COUNT
          LX2    59-54-59+6
          SX1    X1
          BX3    X7*X2
          BX1    X1+X3
          ZR     X1,CMP3     IF NO DATA TRANSFERRED
          ERX3   X4          SET FILE WRITTEN ON FLAG
          LX2    59-10-59+54
          BX1    -X2*X7      SET WRITTEN SINCE OPEN IF NOT REWRITE
          LX7    6-59
          BX7    X7+X3
          LX1    7-59
          BX7    X7+X1
          EWX7   X4
          SX2    BMFL*100B   FLUSH WRITE BUFFER IF REWRITE
          SB4    CMP3        SET RETURN ADDRESS FOR *CIM*
          ZR     X1,CIM      IF REWRITE
 CMP3     SA0    CMP4        SET RETURN ADDRESS FOR *UAC*
          SB6    RCR5        RETURN ADDRESS IF TRACK INERLOCK REJECT
          MX7    1           SET TO RECALL CPU, PREVENT *UADM* ISSUE
          EQ     UAC         UPDATE ACCOUNTING
 
 CMP4     ERX1   X4          SET FST NOT BUSY
          SX7    B1
          IX3    X5-X7       SET FET COMPETE
          BX6    X1+X7
          ERX1   X3
          EWX6   X4          STORE FST
          BX7    X1+X7
          SX6    B4          SET *UADM* PARAMTER WORD COUNT
          EWX7   X3          STORE FET AFTER FST
          BX6    X6+X2       SET RECALL CPU FLAG
          SX1    UADM        SET EXIT FUNCTION
*         EQ     PPCX        EXIT
 PPCX     SPACE  4,10
**        PPCX - CIO PROCESSOR EXIT.
*
*         ENTRY  (A5) = ADDRESS OF PSEUDO OUTPUT REGISTER.
*                (X1) = EXIT FUNCTION (DPPM, RECM, RPPM).
*                (X6) = FUNCTION PARAMETERS.
*
*         EXIT   TO MONITOR MODE *CPUMTR* TO DROP CPU.
*                P REGISTER RESET TO *PPC* FOR NEXT CIO CALL
*                (XJ MUST IMMEDIATELY PRECEED *PPC* ENTRY POINT).
 
 
 PPCX     LX1    -12         STORE EXIT FUNCTION IN OUTPUT REGISTER
          LX6    36
          BX6    X6+X1
          SA6    A5
 PPCX1    XJ                 EXIT TO CPUMTR AND DROP CPU
 
 PPCX2    SA1    A5          CHECK OUTPUT REGISTER
          AX1    48
          NZ     X1,PPCX2    IF OUTPUT REGISTER NOT CLEARED
*         EQ     PPC         PROCESS *CIO* REQUEST
          TITLE  CIO PROCESSOR MAIN ROUTINE.
 PPC      SPACE  4,20
**        PPC - PSEUDO PP CIO FUNCTION PROCESSOR (ENTRY).
*
*         EXIT   (X6) = BUFFER SPACE/DATA IN PRUS FOR READ/WRITE.
*                (X7) = BUFFER SPACE/DATA WORD COUNT FOR READ/WRITE.
*                TO *CMP3* IF PREVIOUS TRACK INTERLOCK CLEAR REJECT
*                   ON COMPLETE FUNCTION.
*                TO *RCR5* IF SET TRACK INTERLOCK REJECT.
*                TO *RDF* IF READ FUNCTION.
*                TO *RDF3* IF SKIP FUNCTION.
*                TO *WTF* IF WRITE FUNCTION.
*
*         ERROR  TO *RPC3* IF INCORRECT FET ADDRESS OR PARAMETER.
*                TO *RPC* IF OTHER USER ERROR.
*
*         USES   A - 0, 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 6, 7.
*                X - ALL.
*
*         CALLS  CBS, CRA, SRA, /MONITOR/VFA, /MONITOR/VFP.
*
*         MACROS MONITOR.
 
 
*         VALIDATE FET ADDRESS.
 
 PPC      SA2    UACC        CLEAR ACCOUNTING CHARGE
          MX7    36
          BX7    X7*X2
          SA1    A5-B1       GET *CIO* CALL
          BX6    X6-X6
          SA7    A2
          MX3    5
          SA6    A5+B1       CLEAR *MB*
          LX3    36-55
          SA6    A6+B1       CLEAR *MB+1*
          BX3    X3*X1       CP NUMBER
          SA6    A5+6        CLEAR DATA CHANGE/WRITE EOI FLAGS
          SB2    B0          INDICATE NO FET ADDRESS
          LX3    -36+7
          SA6    PRUC        CLEAR PRU COUNT
          SB3    RPC3        SET ERROR EXIT ADDRESS FOR *VFA*/*VFP*
          SB6    PPC1        SET RETURN ADDRESS FOR *VFP*
          SB7    X3          CONTROL POINT ADDRESS
          SA6    A6-B1       CLEAR MASS STORAGE PRU CHANGE
          ERRNZ  PRUC-PCMS-1 INDEXES MUST BE CONSECUTIVE
          SX7    /CIOERR/ARG *FET ADDRESS OUT OF RANGE*
          EQ     /MONITOR/VFA  VERIFY FET ADDRESS
 
*         VALIDATE FET PARAMETERS.
 
 PPC1     SA4    A5+5        GET MESSAGE BUFFER PARAMETERS
          MX2    -24
          BX5    -X2*X5      ABSOLUTE FET+1
          PL     X4,PPC3     IF NOT RESTART FROM RECALL STACK
          MX2    -2
          SA6    A4-B1       SAVE FET LENGTH - 5 AND RANDOM FLAG
          SB6    PPC2        SET RETURN ADDRESS FOR *VFP*
          BX6    -X2*X4      GET FET PARAMETER VALIDATION FLAGS
          SX1    B0
          SX7    /CIOERR/BUF *BUFFER ARGUMENT ERROR*
          NZ     X6,/MONITOR/VFP  IF FET PARAMETER VALIDATION REQUIRED
 PPC2     SA2    A4-B1       GET FET LENGTH - 5 AND RANDOM FLAG
          BX7    X1+X2       SAVE FIRST AND LIMIT
          SA6    A2-B1       SAVE IN AND OUT
          SA7    A2
 PPC3     SA2    A4
          MX3    -24
          BX0    -X3*X0
          BX6    X0
          SA6    ABRA        ABSOLUTE RA
          MX6    -12
          BX3    -X6*X2      INTERNAL FUNCTION CODE
          LX2    -24
          BX1    -X6*X2      FNT ORDINAL
          SX4    X1-FSTL
          IX4    X0-X4       ABSOLUTE FST ADDRESS
          LX2    59-58+24
          ZR     X3,CMP3     IF TRACK INTERLOCK CLEAR REJECT
 
*         INTERLOCK TRACK FOR PERMANENT FILE.
 
          SX1    B1
          IX1    X4-X1
          ERX1   X1          CHECK FILE TYPE
          MX6    -6
          LX1    -6
          BX6    -X6*X1
          LX1    -9
          MX7    -2
          SX6    X6-PMFT
          BX7    -X7*X1      CHECK ACCESS MODE
          SA6    PMFF
          SA7    FMOD
          NG     X2,PPC5     IF TRACK INTERLOCK ALREADY SET
          NZ     X6,PPC5     IF NOT DIRECT ACCESS PERMANENT FILE
          LX7    59-1
          PL     X7,PPC5     IF NOT M, A, RM, OR RA MODE
          ERX1   X4          SET EQUIPMENT AND FIRST TRACK
          SX6    STIS*10000B SET TRACK INTERLOCK SUBFUNCTION
          MX2    24
          BX1    X2*X1
          LX1    -12
          BX6    X6+X1
          MONITOR  STBM
          AX1    36
          MX7    1
          ZR     X1,PPC4     IF TRACK INTERLOCK SET
+         EQ     RCR5        ENTER RECALL STACK
 
 PPC4     SA2    A4          SET TRACK INTERLOCK FLAG
          LX7    58-59
          BX7    X2+X7
          SA7    A4
 
*         PRESET FOR RANDOM READ/WRITE/SKIP.
 
 PPC5     ERX1   X4          GET EQUIPMENT
          MX7    -12
          LX1    12
          BX7    -X7*X1
          MX6    -12
          CX2    X7,EST      CONVERT EST ORDINAL TO OFFSET
          TA2    X2+EQDE,EST READ EST ENTRY
          BX7    -X6*X2      MST ADDRESS / 10B
          LX7    3
          SA3    X7+MDGL     GET SECTOR LIMIT
          BX6    -X6*X3
          LX7    18
          BX7    X7+X6
          SA7    A4+B1       SAVE EQUIPMENT CHARACTERISTICS
          SA2    A4          GET MESSAGE BUFFER PARAMETERS
          SA1    A4-B1       GET RANDOM FILE FLAG
          LX2    59-54
          BX1    -X1+X2
          MX6    -24
          NG     X1,PPC9     IF PRIOR DATA TRANSFER OR NOT RANDOM FILE
          LX2    59-7-59+54
          SB4    PPC9        SET RETURN ADDRESS FOR *SRA*
          SX1    5
          NG     X2,SRA      IF RANDOM SKIP
          IX1    X5+X1
          ERX1   X1
          LX2    59-6-59+7
          BX3    -X6*X1
          ZR     X3,PPC9     IF RANDOM ADDRESS NOT SET
          PL     X2,CRA      IF RANDOM READ
          SB4    PPC8        SET RETURN ADDRESS FOR *CRA*
          LX2    59-10-59+6
          NG     X2,CRA      IF REWRITE FUNCTION
          LX1    59-29       CHECK WRITE-IN-PLACE FLAG
          MX7    1
          PL     X1,PPC6     IF NOT REWRITE
          BX7    X7+X2       SET REWRITE FLAG
          LX7    10-59
          SA7    A4
          EQ     CRA         CONVERT RANDOM ADDRESS
 
*         PROCESS RANDOM WRITE AT EOI.
 
 PPC6     SX1    X3-2        CHECK RANDOM ADDRESS VALUE
          SX7    /CIOERR/RWT *INDEX ADDRESS OUT OF RANGE*
          NG     X1,RPC      IF RANDOM INDEX RETURN ADDRESS .LT. 2
          SA2    B7+FLSW     GET *FL*
          MX6    -12
          BX2    -X6*X2
          LX2    6
          IX1    X3-X2
          PL     X1,RPC      IF RANDOM INDEX RETURN ADDRESS .GE. FL
          SA0    X3          SAVE RELATIVE ADDRESS OF RANDOM INDEX WORD
          BX3    X3-X3       SKIP TO EOI
          SB4    PPC7        SET RETURN ADDRESS FOR *CRA*
          EQ     CRA         CONVERT RANDOM ADDRESS
 
 PPC7     SA2    ABRA        GET RANDOM INDEX RETURN WORD
          SX6    A0
          IX2    X2+X6
          ERX1   X2
          MX6    36
          BX6    X6*X1
          BX6    X6+X3
          EWX6   X2          RETURN RANDOM INDEX
          EQ     PPC9        CHECK BUFFER SPACE
 
 PPC8     ERX1   X4          SET LAST OPERATION COMPLETE WRITE
          MX6    56
          BX6    X6*X1
          SX2    6
          BX6    X6+X2
          EWX6   X4
 
*         THE FOLLOWING LOGIC ACCOMPLISHES TWO PURPOSES.
*
*         1)     IT CAUSES THE LAST BUFFER ACCESSED TO BE FLUSHED IF
*         IT CONTAINS WRITE DATA, AND IT IS NOT GOING TO BE ACCESSED
*         FURTHER FOR WRITING.
*
*         2)     FOR *PMFT* FILES IT WILL RECALL THE NEW REQUEST IF IT
*         IS FOR OTHER THAN A WRITE ACCESS TO THE LAST BUFFER
*         ACCESSED, AND THE LAST BUFFER ACCESSED CONTAINS WRITE DATA
*         WHICH HAS NOT BEEN FLUSHED TO DISK.  EVEN IF THE BUFFER IS
*         ON THE UNIT I/O QUEUE THE REQUEST WILL BE RECALLED.  THIS
*         IS DONE SO THAT ALL UPDATES TO *PMFT* FILES WILL OCCUR IN
*         ORDER OF USER REQUEST.  THIS IS NECESSARY FOR USER FILE
*         RECOVERY AFTER A SYSTEM INTERRUPT OCCURS WHICH REQUIRES A
*         LEVEL 0 DEADSTART.
 
 PPC9     R=     X1,FUTL-FSTL  CHECK I/O BUFFER LINK
          IX1    X4+X1
          ERX1   X1
          MX6    -12
          BX7    -X6*X1
          ZR     X7,PPC14    IF NO I/O BUFFER LINK
          LX7    CBTLS       CHECK IF THIS FUNCTION ON SAME BUFFER
          ERX1   X4
          TA2    X7+FSTC,CBT READ CONTROL BUFFER FST
          MX0    21
          BX1    X1-X2
          LX0    -3
          BX0    X0*X1
          SA3    A2+B1
          ERRNZ  IOLK-FSTC-1 CODE ASSUMES CONSECUTIVE WORDS
          NZ     X0,PPC15    IF BUFFER MAY NOT BE FOR THIS FILE
          SA2    INBA
 PPC10    LX3    59-57
          BX0    X2*X1
          PL     X3,PPC13    IF BUFFER DOES NOT CONTAIN WRITE DATA
          NZ     X0,PPC11    IF NEW REQUEST NOT FOR THIS BUFFER
          SA2    A4
          LX2    59-6
          SB6    WTF
          NG     X2,CBS      IF WRITE TO THE SAME BUFFER
 PPC11    SX2    BMFL*100B   FLUSH WRITE BUFFER
          SB4    PPC12       SET RETURN ADDRESS FOR *CIM*
          LX3    57-59
          PL     X3,CIM      IF I/O INTERLOCK NOT SET
 PPC12    SA1    PMFF
          ZR     X1,RCR2     IF DIRECT ACCESS PERMANENT FILE
 PPC13    ZR     X0,PPC14    IF REQUEST FOR THIS BUFFER
          R=     X0,FUTL-FSTL  CLEAR BUFFER LINK
          IX0    X4+X0
          ERX1   X0
          MX6    48
          BX6    X6*X1
          EWX6   X0
 PPC14    SA2    A4          GET MESSAGE BUFFER PARAMETERS
          BX7    X7-X7       SET *CHRV*
          SA7    CHRV
          LX2    59-7
          NG     X2,RDF3     IF SKIP FUNCTION
          LX2    59-6-59+7
          SB6    RDF         SET *CBS* EXIT ADDRESS
          PL     X2,CBS      IF READ FUNCTION
          SB6    WTF         SET RETURN ADDRESS FOR *CBS*
          EQ     CBS         CHECK BUFFER SIZE
 
 PPC15    MX7    12
          LX7    -12
          BX6    X7*X2
          NZ     X6,PPC13    IF FIRST TRACK DEFINED IN CONTROL BUFFER
          SA2    INBA
          BX6    -X7*X0      COMPARE ONLY EQUIPMENT
          ZR     X6,PPC10    IF BUFFER MAY BE FOR THIS FILE
          EQ     PPC13       CLEAR BUFFER INDEX
          TITLE  CIO READ PROCESSOR.
 RDF      SPACE  4,10
**        RDF - READ/SKIP FORWARD FUNCTION PROCESSOR.
*
*         ENTRY  AT *RDF* FROM *PPC* VIA *CBS* IF READ FUNCTION.
*                AT *RDF3* FROM *PPC* IF SKIP FORWARD FUNCTION.
*                (X6) = BUFFER SIZE IN PRUS, IF ENTRY AT *RDF*.
*                (X7) = WORD COUNT OF DATA REMAINING IN BUFFER,
*                       IF ENTRY AT *RDF*.
*
*         EXIT   TO *CMP* FOR COMPLETED FUNCTION.
*                TO *CMP5* IF UNNECESSARY READ FUNCTION.
*                TO *RCR* IF PRU TRANSFER LIMIT.
*
*         ERROR  EXIT TO *RPC* IF ERROR DETECTED.
*
*         USES   A - 0, 1, 2, 3, 6, 7.
*                B - 2, 4, 6.
*                X - 1, 2, 3, 6, 7.
*
*         CALLS  BRD, CBS, CIM, CPT, CRD, CSP, RBI, ULA, ULP.
 
 
 RDF      NZ     X6,RDF1     IF ROOM IN BUFFER
          SB2    B0          SET TERMINATION CONDITION NOT REACHED
          SA2    A4          GET MESSAGE BUFFER PARAMETERS
          LX2    59-10
          PL     X2,CMP5     IF NOT *READSKP*
          LX2    59-56-59+10
          NG     X2,RDF1     IF SKIP DATA TRANSFER FLAG SET
          SX6    14B         CLEAR TERMINATION TO SET PRU STOP
          LX2    -59+56
          BX6    -X6*X2
          SA6    A4+
          SX7    B1+         RESET 1 PRU IN BUFFER
          SA7    NPCB
 RDF1     ERX1   X4          GET FST ENTRY
          LX1    59-11
          SA2    A4
          LX2    59-5
          SB5    RDF3        SET RETURN ADDRESS FOR *ULP*
          PL     X1,RDF2     IF NOT SYSTEM SECTOR OPERATION
          MX6    -59
          BX6    -X6*X1      CLEAR SYSTEM SECTOR OPERATION FLAG
          SX7    /CIOERR/IRQ *ILLEGAL I/O REQUEST*
          PL     X2,RPC      IF NOT CONTROL WORD READ
          LX6    11-59
          EWX6   X4
 RDF2     LX2    59-4-59+5
          PL     X2,RDF3     IF NOT *RPHRLS*/*READLS* FUNCTION
          SA1    A4-B1       GET FET LENGTH
          LX1    1
          SX7    /CIOERR/FPE *FET PARAMETER ERROR*
          AX1    49
          ZR     X1,RPC      IF NO LIST ADDRESS WORD IN FET
          SX1    4
          IX1    X5+X1
          ERX1   X1
          BX7    X7-X7       SET INITIAL CONVERSION FLAG
          LX1    59-23
          SA7    ULPA
          PL     X1,ULP      IF NOT CONTINUATION OF PREVIOUS OPERATION
 
*         INTERLOCK I/O BUFFER READ BUFFER.
 
 RDF3     ERX2   X4          READ FST
          SA1    PRUC        CHECK FOR PRU TRANSFER LIMIT
          LX2    -48
          MX6    -12
          SX1    X1+LSLB
          BX3    -X6*X2      EST ORDINAL
          AX1    12
          NZ     X1,RCR      IF PRU TRANSFER LIMIT
          CX1    X3,EST      CONVERT EST ORDINAL TO OFFSET
          TA3    X1+EQDE,EST READ EST ENTRY
          SX1    B1
          LX7    X3,B1
          TA3    SYFO*FNTG+FSTG,FNT  READ SYSTEM FILE FST
          LX2    48
          BX3    X3-X2
          PL     X7,RDF3.1   IF NOT SYSTEM DEVICE
          SA2    CHRV
          SX7    40B
          LX3    -36
          BX7    X2+X7       SET *READSYS* FLAG IN *CHRV*
          BX3    -X6*X3
          NZ     X3,RDF3.1   IF NOT SYSTEM FILE READ
          SA7    A2
 RDF3.1   IX1    X4+X1
          SA2    LBIA
          ERX1   X1          READ FNT LINK WORD
          ZR     X2,RDF4     IF NO BUFFER INTERLOCKED
          BX6    -X6*X1      I/O BUFFER LINK
          SX2    B1          SET INTERLOCK VALUE
          SB6    RDF5        SET RETURN ADDRESS FOR *CSP*
          NZ     X6,CSP      IF LINK SET IN FNT
          SA0    RDF4        SET RETURN ADDRESS FOR *RBI*
          EQ     RBI         RELEASE BUFFER INTERLOCK
 
 RDF4     SX2    BMVI*100B+BMRD  VALIDATE I/O BUFFER
          SB4    CPT         SET RETURN ADDRESS FOR *CIM*
          EQ     CIM         CALL I/O BUFFER MANAGER
 
 RDF5     SB4    CPT         SET RETURN ADDRESS FOR *CIM*
          SX2    BMRG*100B   RELEASE BUFFER AND GET NEXT BUFFER
          NG     X7,CIM      IF SECTOR NOT IN SAME BUFFER
          SX7    X7-LSLB
          PL     X7,CIM      IF SECTOR NOT IN SAME BUFFER
          EQ     CPT         EXIT TO CALCULATE PRUS TO TRANSFER
 
*         REENTRY FROM *CPT*.
*         PROCESS DATA.
 
 RDF6     SA3    LBIA        GET TRACK LINKAGE
          SA1    X3+PAD4
          MX3    -12
          BX6    -X3*X1      SAVE TRACK LINKAGE
          LX6    48
          SA2    A4
          SA6    STLR
          ZR     B3,RDF11    IF EOI ONLY
          LX2    59-56
          SA1    A5+3        GET *IN*
          SX6    B6          WORD COUNT OF TRANSFER
          NG     X2,RDF9     IF SKIP DATA TRANSFER
          SB6    RDF8        SET *BRD* EXIT ADDRESS
          AX1    24
          LX2    59-5-59+56
          NG     X2,CRD      IF *READCW*
          LX2    59-10-59+5
          PL     X2,BRD      IF NOT *READSKP*
          LX2    -59+10
          SX3    14B
          BX3    X3*X2
          NZ     X3,BRD      IF NOT ON PARTIAL SECTOR
          SX7    /CIO/EOR    RESET EOR STOP
          MX3    1
          BX7    X7+X2
          LX3    56-59
          BX7    X7+X3       SET SKIP DATA TRANSFER FLAG
          SA3    WCCB        GET WORD COUNT OF *CIO* BUFFER
          SA7    A4
          IX2    X3-X6
          PL     X2,BRD      IF ENOUGH ROOM IN BUFFER FOR SHORT PRU
          SX6    X3+         GET WORD COUNT OF *CIO* BUFFER
          EQ     BRD         COMPLETE FILL OF *CIO* BUFFER
 
*         REENTRY FROM *BRD*/*CRD*.
*         UPDATE *IN* POINTER IN FET AND MESSAGE BUFFER.
 
 RDF8     SX6    X1          UPDATE *IN* IN FET
          SX2    B1
          SA1    A5+3        UPDATE *IN* IN MESSAGE BUFFER
          IX2    X5+X2
          EWX6   X2
          SX1    X1+         *OUT*
          LX6    24
          BX6    X6+X1
          SA6    A1+
 
*         UPDATE CURRENT TRACK AND SECTOR IN FST.
*         UPDATE PRU COUNT.
 
 RDF9     SA2    NPTR        GET PRU COUNT OF TRANSFER
          ERX1   X4          UPDATE CURRENT TRACK AND SECTOR IN FST
          LX1    -12
          IX6    X1+X2       ADVANCE CURRENT SECTOR
          SA1    NPCB        DECREMENT BUFFER SPACE PRU COUNT
          IX7    X1-X2
          MX3    -LSLBS
          BX3    -X3*X6      MOD *LSLB* OF SECTOR
          NZ     X3,RDF10    IF NOT LAST PRU IN CONTROL BUFFER
          SA3    STLR        GET SECTOR/TRACK LINKAGE
          PL     X3,RDF10    IF NOT END OF TRACK
          MX1    36
          BX6    X1*X6       CLEAR CURRENT SECTOR
          LX3    24
          BX6    X6+X3       SET NEXT TRACK
 RDF10    LX6    12
          SA3    PRUC        INCREMENT PRU COUNT
          EWX6   X4
          IX6    X3+X2
          SA7    A1
          SA6    A3
          SA2    A4          GET TERMINATION STATUS
 
*         CHECK FOR PRU/EOR/EOF/EOI TERMINATION.
 
 RDF11    ERX1   X4          SET STATUS IN FST
          MX6    56
          BX6    X6*X1
          SX3    B2
          BX6    X6+X3
          EWX6   X4
          SX7    14B
          BX7    X7*X2
          IX1    X3-X7
          PL     X1,RDF14    IF TERMINATION CONDITION REACHED
 
*         CHECK FOR BUFFER FULL TERMINATION.
 
 RDF12    SA2    A4
          SA1    NPCB        CHECK BUFFER SPACE
          LX2    59-56
          SX6    X1+
          NG     X2,RDF3     IF SKIP DATA TRANSFER
          SB6    RDF13       SET RETURN ADDRESS FOR *CBS*
          ZR     X6,CBS      IF NO MORE ROOM IN BUFFER
 RDF13    NZ     X6,RDF3     IF MORE ROOM IN BUFFER
          SA2    A4
          LX2    59-10
          SB2    0           PREVENT SETTING FET TERMINATION STATUS
          PL     X2,CMP      IF NOT *READSKP*
          SX6    14B         CLEAR TERMINATION TO SET PRU STOP
          LX2    10-59
          BX6    -X6*X2
          SA6    A4
          SX7    B1          RESET 1 PRU IN BUFFER
          SA7    NPCB
          EQ     RDF3        PROCESS PARTIAL SECTOR
 
*         PRU/EOR/EOF/EOI STOP ENCOUNTERED.
*         ADVANCE *READLS*/*RPHRLS*.
 
 RDF14    SB5    ULA         SET RETURN ADDRESS FOR *ULP*
          LX2    59-4
          SX7    B1
          NG     X2,ULP      IF *READLS*/*RPHRLS*
          SB4    B2-/CIO/EOF
          LX2    59-10-59+4
          PL     X2,CMP      IF NOT SKIP/*READSKP*
          LX2    59-7-59+10
          NG     X2,RDF15    IF NOT *READSP*
 
*         PROCESS *READSKP* FUNCTION.
 
          LX2    0-20-59+7+60  GET LEVEL NUMBER
          MX1    56
          BX1    X1+X2
          MX7    1
          NZ     X1,CMP      IF *READSKP* TO EOR COMPLETE
          GE     B4,CMP      IF *READSKP* TO EOF COMPLETE
          LX7    56-59
          LX2    20-0        SET SKIP DATA TRANSFER FLAG
          BX7    X7+X2
          SA7    A4
          EQ     RDF3        CONTINUE SKIP FOR *READSKP*
 
*         ADVANCE SKIP FUNCTION.
 
 RDF15    SA1    A5-B1       DECREMENT SKIP COUNT
          GT     B4,CMP      IF EOI ENCOUNTERED
          LX1    -18
          IX7    X1-X7
          SX1    X7
          LX7    18
          SA7    A1
          NZ     X1,RDF3     IF SKIP FUNCTION NOT COMPLETE
          EQ     CMP         EXIT
 BRD      SPACE  4,15
**        BRD - BUFFER READ DATA.
*
*         ENTRY  (B6) = RETURN ADDRESS.
*                (X0) = FWA DATA IN I/O BUFFER.
*                (X1) = *IN*.
*                (X6) = WORD COUNT TO TRANSFER.
*
*         EXIT   (X1) = ADVANCED *IN* POINTER.
*                (X6) = 0, IF NO DATA TRANSFERRED.
*
*         USES   A - 0, 2.
*                B - 4, 5.
*                X - 0, 2, 3, 6, 7.
*
*         CALLS  ABP.
 
 
 BRD      ZR     X6,RB6      IF NO DATA TO TRANSFER
          SA2    ABRA        ABSOLUTE RA
          LX0    -30
          IX2    X1+X2       ABSOLUTE *IN*
          SA0    X2
          BX0    X0+X2
          LX0    30          30/ABSOLUTE *IN*, 30/FWA I/O BUFFER DATA
          SX7    X6          WORD COUNT OF TRANSFER
          SB4    BRD1        SET RETURN ADDRESS FOR *ABP*
          EQ     ABP         ADVANCE *IN*
 
 BRD1     NG     X7,BRD4     IF NO SECOND PART TO TRANSFER
          IX6    X6-X7       NUMBER OF WORDS IN FIRST PART
          SX3    X2          RELATIVE *FIRST*
          SB4    X6          SET TRANSFER SIZE
          SB5    BTSZ
          BX2    X2-X2
          GE     B5,B4,BRD3  IF ONE BLOCK OR LESS TO READ
          SA2    PSTA        ADDRESS INCREMENT WORD
 BRD2     RE     BTSZ
          RJ     HHE         HANG ON HALF-EXIT
          SB5    B5+BTSZ     INCREMENT ADDRESSES
          SA0    A0+BTSZ
 BRD3     IX0    X0+X2
          LT     B5,B4,BRD2  IF MORE BLOCKS TO TRANSFER
          SB5    B4-B5
          RE     B5+BTSZ
          RJ     HHE         HANG ON HALF-EXIT
          MX2    -30
          SX6    B5+BTSZ     SET WORD COUNT OF LAST BLOCK
          BX0    -X2*X0      CLEAR CM ADDRESS FIELD
          IX0    X0+X6       ADVANCE I/O BUFFER ADDRESS
          SA2    ABRA        ABSOLUTE *RA*
          IX3    X3+X2       ABSOLUTE *FIRST*
          SA0    X3
          LX3    30
          BX0    X0+X3
          BX6    X7          SET BLOCK SIZE OF SECOND BLOCK
 BRD4     SB4    X6          SET TRANSFER SIZE
          SB5    BTSZ
          BX2    X2-X2
          GE     B5,B4,BRD6  IF .LE. ONE BLOCK TO TRANSFER
          SA2    PSTA
 BRD5     RE     BTSZ
          RJ     HHE         HANG ON HALF-EXIT
          SB5    B5+BTSZ
          SA0    A0+BTSZ     INCREMENT ADDRESSES
 BRD6     IX0    X0+X2
          LT     B5,B4,BRD5  IF MORE FULL BLOCKS TO TRANSFER
          SB5    B4-B5
          RE     B5+BTSZ
          RJ     HHE         HANG ON HALF-EXIT
          JP     B6          RETURN
 CRD      SPACE  4,15
**        CRD - CONTROL WORD READ DATA.
*
*         ENTRY  (B2) = READ STATUS.
*                (X0) = FWA OF DATA IN I/O BUFFER.
*                (X1) = *IN*.
*                (X6) = WORD COUNT OF TRANSFER.
*                (NPTR) = NUMBER OF PRUS TO TRANSFER.
*
*         EXIT   TO *RDF8*.
*
*         USES   A - 2, 3, 7.
*                B - 3, 4, 6.
*                X - 0, 2, 3, 6, 7.
*
*         CALLS  ABP, BRD.
 
 
 CRD      BX3    X6          SAVE WORD COUNT, INITIALIZE PRU COUNT
          LX3    30
 CRD1     SX6    1           INCREMENT PRU COUNT
          BX7    X3
          IX3    X3+X6
          SA2    NPTR        GET NUMBER OF PRUS TO TRANSFER
          SX6    X3
          IX2    X2-X6
          NG     X2,RDF8     IF NO MORE PRUS TO TRANSFER
          AX7    30+6        CALCULATE REMAINING WORD COUNT
          IX2    X7-X6
          SX6    100B        SET FULL BLOCK WORD COUNT
          PL     X2,CRD2     IF FULL BLOCK TO TRANSFER
          LX7    30+6
          IX6    X3-X7
          AX6    30          WORD COUNT OF TRANSFER
          NZ     X6,CRD2     IF DATA TO TRANSFER
          SX2    B2-/CIO/EOF
          NZ     X2,CRD2     IF NOT EOF
          SX7    14B
          SA2    A4
          BX2    X7*X2
          SX2    X2-/CIO/EOF
          ZR     X2,RDF8     IF TERMINATE ON EOF
 
*         PROCESS HEADER CONTROL WORD.
 
 CRD2     BX7    X6          WORD COUNT
          SX2    B1
          LX2    36+6        PRU SIZE
          LX7    2
          IX7    X7+X6       BYTE COUNT
          BX7    X7+X2
          SA2    ABRA        *RA*
          IX2    X1+X2
          EWX7   X2          STORE HEADER CONTROL WORD IN BUFFER
          SB4    BRD         SET RETURN ADDRESS FOR *ABP*
          IX7    X0+X6       SAVE ADVANCED I/O BUFFER DATA ADDRESS
          SA7    CWLA
          BX7    X3          SAVE SECTOR COUNT
          SA7    A7+B1
          SX7    B1          SET TO ADVANCE *IN* BY 1 WORD
          SB6    CRD3        SET RETURN ADDRESS FOR *BRD*
          EQ     ABP         ADVANCE *IN*
 
*         PROCESS TRAILER CONTROL WORD.
 
 CRD3     ERX2   X4          BUILD TRAILER CONTROL WORD
          MX7    -24
          SA3    CWLA+1      RESTORE SECTOR COUNT
          LX2    -12
          BX7    -X7*X2      CURRENT TRACK AND SECTOR
          SX0    X3-1        GET PRU COUNT
          IX0    X7+X0
          LX2    12+3
          MX7    9
          BX7    X7*X2       EQUIPMENT
          LX7    -27
          MX2    4
          NZ     X6,CRD4     IF DATA TRANSFERRED
          SB3    B2-/CIO/EOF
          NZ     B3,CRD4     IF NOT EOF
          LX2    -8
          BX7    X7+X2
 CRD4     BX7    X7+X0
          SA2    ABRA        *RA*
          IX2    X1+X2
          EWX7   X2          STORE TRAILER CONTROL WORD
          SX7    B1
          SA2    A3-B1       GET ADVANCED I/O BUFFER DATA ADDRESS
          SB4    CRD1        SET RETURN ADDRESS FOR *ABP*
          BX0    X2
          EQ     ABP         ADVANCE *IN*
 ULA      SPACE  4,10
**        ULA - UPDATE LIST ACCOUNTING.
*
*         ENTRY  (CLEA) = ABSOLUTE ADDRESS OF CURRENT LIST ENTRY.
*                (X3) = RANDOM ADDRESS FOR CURRENT ENTRY.
*
*         EXIT   TO *RDF12* TO CONTINUE DATA TRANSFER.
*                (ULPA) = CURRENT RANDOM ADDRESS.
*                (ULPA+1) = CURRENT FST.
*
*         USES   A - 1, 2, 3, 6.
*                X - 0, 1, 2, 3, 6.
 
 
 ULA      ERX1   X4          GET FST
          BX6    X3          SAVE CURRENT RANDOM ADDRESS
          SA6    ULPA
          SA2    CLEA
          BX6    X1          SAVE FST
          SA6    A6+B1
          SX1    B1          GET PREVIOUS RANDOM ADDRESS
          IX1    X2-X1
          MX0    -24
          ERX1   X1
          BX1    -X0*X1
          SA2    PRUC        SAVE OLD PRU COUNT
          SX6    X2
          LX6    30
          SX2    X2
          BX6    X6+X2
          SA6    A2
          IX1    X3-X1       CURRENT POSITION - PREVIOUS POSITION
          NG     X1,ULA1     IF BACKWARD POSITIONING
          SX1    X1-IMPL-1   CHECK IF NEW POSITIONING ABOVE THRESHOLD
          NG     X1,RDF12    IF NOT ABOVE THRESHOLD
 ULA1     SA2    UACC        INCREMENT ACCOUNTING CHARGE
          SX6    IMRL
          IX6    X2+X6
          SA6    A2
          EQ     RDF12       CONTINUE DATA TRANSFER
 ULP      SPACE  4,10
**        ULP - UPDATE LIST POINTER.
*
*         ENTRY  (B5) = EXIT ADDRESS.
*
*         EXIT   (CLEA) = ABSOLUTE ADDRESS OF CURRENT LIST ENTRY.
*                TO *CMP* IF END OF LIST ENCOUNTERED.
*
*         ERROR  TO *RPC* IF INCORRECT LIST ADDRESS.
*
*         USES   A - 1, 2, 6, 7.
*                B - 2, 6.
*                X - 0, 1, 2, 6, 7.
*
*         CALLS  CRA.
 
 
 ULP      SX0    4           GET LIST POINTER
          IX0    X5+X0
          ERX1   X0
          SA2    B7+FLSW     GET FL
          MX6    -12
          BX2    -X6*X2
          LX2    6
          SB6    X1
          SX7    /CIOERR/FPE *FET PARAMETER ERROR*
          LE     B6,B1,RPC   IF LIST POINTER .LE. 1
          BX6    X1          CHECK FOR CONTINUATION
          LX6    59-23
          NG     X6,ULP1     IF CONTINUATION
          SX6    B1          PREVENT ADVANCE OF LIST POINTER
          IX1    X1-X6
          LX6    23-0
          BX1    X1+X6       SET CONTINUATION FLAG
 ULP1     SX6    1           ADVANCE LIST ADDRESS
          IX6    X1+X6
          EWX6   X0
          SX6    X6
          IX2    X6-X2
          PL     X2,RPC      IF LIST POINTER .GE. FL
          SA2    ABRA        ABSOLUTE *RA*
          IX7    X2+X6
          SA7    CLEA        SAVE CURRENT LIST ENTRY ABSOLUTE ADDRESS
          ERX2   X7          GET RANDOM ADDRESS
          MX7    -24
          SA1    ULPA
          BX3    -X7*X2
          IX6    X3-X1       CURRENT - PREVIOUS RANDOM ADDRESS
          ZR     X3,ULP2     IF END OF LIST
          SB4    ULP2.1      SET RETURN ADDRESS FOR *CRA*
          ZR     X1,CRA      IF INITIAL CALL
          SA2    A1+B1       GET FST
          MX0    -12
          LX2    -12         EXTRACT SECTOR NUMBER SAVED IN FST
          BX1    -X0*X2
          IX7    X1+X6       FST SECTOR + RANDOM ADDRESS INCREMENT
          SA1    A4+B1       GET SECTORS PER TRACK
          SX6    X1
          IX1    X7-X6
          NG     X7,CRA      IF NEW RANDOM ADDRESS BEFORE THIS TRACK
          PL     X1,CRA      IF NEW RANDOM ADDRESS AFTER THIS TRACK
          LX2    -12         EXTRACT CURRENT TRACK
          BX0    -X0*X2
          EQ     SFP         SET UPDATED FST POSITION
 
 ULP2.1   R=     X1,FUTL-FSTL
          IX0    X4+X1
          ERX1   X0
          MX6    -12
          BX7    -X6*X1
          ZR     X7,ULP2.2   IF NO BUFFER INDEX
          LX7    CBTLS
          ERX2   X4
          TA3    X7+FSTC,CBT
          BX2    X2-X3
          SA3    INBA
          BX2    X3*X2
          BX6    X6*X1
          ZR     X2,ULP2.2   IF ACCESSING THE SAME BUFFER
          EWX6   X0          CLEAR BUFFER INDEX
 ULP2.2   JP     B5          EXIT
 
*         PROCESS END OF LIST.
 
 ULP2     MX7    1
          ERX1   X0          CLEAR CONTINUATION FLAG
          LX7    23-59
          BX7    -X7*X1
          EWX7   X0
          SB2    /CIO/EOF    SET EOF RETURN FOR FET
          EQ     CMP         EXIT
 
 
 ULPA     CON    0           PREVIOUS RANDOM ADDRESS
          CON    0           FST FOR PREVIOUS RANDOM ADDRESS
          TITLE  CIO WRITE PROCESSOR.
 WTF      SPACE  4,20
**        WTF - WRITE FUNCTION PROCESSOR.
*
*         ENTRY  (X6) = (NPTR) = NUMBER OF PRUS TO TRANSFER THIS PASS.
*                (X7) = (WCCB) = WORD COUNT OF DATA IN BUFFER IF WRITE,
*                                ROOM REMAINING IN BUFFER IF READ.
*
*         EXIT   TO *CMP* IF FUNCTION COMPLETE.
*                TO *CMP5* IF UNNECESSARY WRITE FUNCTION.
*                TO *RCR* IF TRANSFER LIMIT.
*                TO *RCR1* IF TRACK LIMIT.
*                TO *RCR2* IF INSUFFICIENT I/O BUFFERS TO
*                   CONTINUE TRANSFER.
*
*         ERROR  EXIT TO *RPC* IF ERROR DETECTED.
*
*         USES   A - 0, 1, 2, 3, 6, 7.
*                B - 2, 3, 4, 6.
*                X - 0, 1, 2, 3, 6, 7.
*
*         CALLS  BWD, CBS, CIM, CMS, CPT, CRA, CSP, CWD, SNT, SRA.
*
*         MACROS MONITOR.
 
 
 WTF      SA3    A4          GET MESSAGE BUFFER PARAMETERS
          SX2    54B
          BX1    X2*X3       TERMINATION CONDITION AND *WRITECW* FLAG
          ERX2   X4          GET FST ENTRY
          SB4    X1-/CIO/EOI
          LX1    59-5
          SB2    B4-/CIO/EOF+/CIO/EOI
          SB6    WTF3        SET RETURN ADDRESS FOR *SNT*
          NZ     X7,WTF1     IF DATA IN BUFFER
          NG     X1,CMP5     IF *WRITECW* WITH NO DATA
          NZ     B2,WTF1     IF NOT EOF OPERATION
          SX1    6
          BX1    X1*X2
          SX1    X1-2
          MX7    1
          ZR     X1,WTF1     IF LAST OPERATION IS INCOMPLETE WRITE
          LX7    56-59       SET SKIP FLAG
          BX3    X3+X7
 WTF1     NZ     X6,WTF2     IF AT LEAST ONE FULL SECTOR IN BUFFER
          ZR     B4,CMP5     IF BUFFERED WRITE
 WTF2     SA1    A4+B1       GET MST ADDRESS
          LX2    -24
          MX7    -12
          AX1    18
          BX0    -X7*X2      CURRENT TRACK
          EQ     SNT         SET NEXT TRACK
 
 WTF3     ERX1   X4
          SA6    NTKP        SAVE OLD EOI SECTOR/NEXT TRACK POINTER
          MX0    1
          LX1    -12
          BX7    -X7*X1      CURRENT SECTOR
          LX0    10-59
          LX1    59-1+12-60
          BX7    X6-X7
          BX6    -X0*X3      CLEAR REWRITE FLAG
          NG     X2,WTF4     IF NOT EOI TRACK
          ZR     X7,WTF5     IF POSITIONED AT EOI
          SX2    -1
 WTF4     BX6    X3
          PL     X1,WTF5     IF LAST OPERATION NOT WRITE
          BX6    X3+X0       SET REWRITE FLAG
 WTF5     SA1    FMOD        GET FILE MODE
          SB5    X1-1
          ZR     X1,WTF6     IF NO RESTRICTIONS
          SX7    /CIOERR/IFM *ILLEGAL MODIFICATION*
          BX0    X0*X6
          ZR     B5,WTF5.1   IF UPDATE MODE
          PL     X2,WTF6     IF POSITIONED AT EOI
          EQ     B5,B1,RPC   IF APPEND MODE
 WTF5.1   ZR     X0,RPC      IF NOT REWRITE FOR UPDATE OR MODIFY MODE
 
*         SET FILE SIZE LIMIT.
 
 WTF6     SA6    A4
          BX3    X2          PRESERVE EOI FLAG
          SX2    B1          GET FILE SIZE INDEX FROM FNT
          IX2    X4+X2
          ERX2   X2
          MX7    -3
          LX2    -30
          BX7    -X7*X2
          LX7    -1
          LX6    59-56
          SA2    TFSL+X7     GET MAXIMUM FILE SIZE IN PRUS
          PL     X7,WTF7     IF VALUE IN UPPER PART OF WORD
          LX2    30
 WTF7     AX2    30
          BX7    X2
          SA7    FSZL        SAVE FILE SIZE LIMIT
          PL     X6,WTF7.1   IF NOT *WRITEF* WITH NO DATA
          SX6    B0+
          SA6    WCCB        CLEAR DATA WORD COUNT
          SA6    NPCB        CLEAR DATA PRU COUNT
 WTF7.1   SB4    WTF7.2
          SB4    -B4
          NG     X3,SRA      IF NOT POSITIONED AT EOI
          ZR     X7,WTF7.5   IF NO FILE SIZE LIMIT
          SB4    WTF7.4
          SB4    -B4         PREVENT FST/FET UPDATE
          EQ     SRA         CALCULATE CURRENT POSITION RANDOM ADDRESS
 
 WTF7.2   SB4    WTF7.3      SET RETURN ADDRESS FOR *CRA*
          BX7    X3          SAVE CURRENT POSITION RANDOM ADDRESS
          SB4    -B4         PREVENT FST/FET UPDATE
          SA7    SCIE
          SX3    B0+
          EQ     CRA         CALCULATE EOI RANDOM ADDRESS
 
 WTF7.3   SA1    SCIE        NUMBER OF SECTORS AFTER CURRENT POSITION
          IX7    X3-X1
          SA7    A1
          EQ     WTF8        PROCESS WRITE
 
 WTF7.4   SA2    FSZL        SET FILE SIZE
          SX1    B2
          IX7    X7+X1       SECTOR COUNT THROUGH END OF TRACK
          LX7    30
          BX6    X2+X7
          SX7    B0
          SA6    A2
 WTF7.5   SA7    SCIE        SET CURRENT POSITION = EOI ((SCIE) = 0)
 
*         CALCULATE NUMBER OF SECTORS FOR WRITE OPERATION.
 
 WTF8     SA2    A4          GET TERMINATION CONDITION
          MX1    -2
          SA0    WTF11       SET RETURN ADDRESS FOR *CMS*
          LX2    -2
          BX1    -X1*X2
          SB6    WTF9        SET RETURN ADDRESS FOR *CBS*
          SB3    X1-/CIO/EOI/4
          ZR     B3,CBS      IF BUFFERED WRITE
          SA3    NPCB        GET NUMBER OF SECTORS IN *CIO* BUFFER
          SB2    X1
          SB2    X3+B2       SECTOR COUNT = FULL PRUS+EOR+EOF+EOI
          EQ     CMS         COMPUTE MOD 40B OF CURRENT SECTOR
 
 WTF9     SA2    A4+
          SB2    X6          SECTOR COUNT = FULL PRUS
          LX2    59-5
          PL     X2,WTF10    IF NOT *WRITECW*
          BX6    X7
          LX2    59-10-59+5
          NG     X2,WTF10    IF REWRITE
          SB2    B2+10B      COMPENSATE FOR SHORT SECTORS
 WTF10    NZ     X6,CMS      IF DATA IN BUFFER
          EQ     CMP         COMPLETE PROCESSING
 
*         CALCULATE NUMBER OF I/O BUFFERS NEEDED FOR WRITE.
 
 WTF11    PX6    X2
          SB2    X1+B2       MOD 40B OF CURRENT SECTOR + SECTOR COUNT
          SA2    A4
          LX2    59-10
          NG     X2,WTF12    IF REWRITE
          SB2    B2+LSLB     ROUND UP NUMBER OF BUFFERS AND COUNT EOI
 WTF12    SX1    B2+
          PX1    X1
          NX6    X6
          FX1    X1/X6
          UX1,B6 X1
          LX1    B6
          SB6    X1          NUMBER OF I/O BUFFERS NEEDED
          SA1    A4+B1       GET SECTORS PER TRACK
          SX7    X1
          SA1    LBIA        CHECK IF BUFFER INTERLOCKED
          AX7    LSLBS
          SB3    X7          NUMBER OF I/O BUFFERS PER TRACK
          SB4    11
          GE     B6,B4,WTF12.1  IF MORE THAN 11 BUFFERS NEEDED
          LE     B6,B3,WTF12.2  IF NOT MORE THAN ONE TRACK OF BUFFERS
          SB4    B3
          EQ     WTF13       RESTRICT TO ONE TRACK WORTH OF BUFFERS
 
 WTF12.1  LE     B4,B3,WTF13 IF NOT MORE THAN ONE TRACK OF BUFFERS
          SB4    B3+
          EQ     WTF13       RESTRICT TO ONE TRACK WORTH OF BUFFERS
 
 WTF12.2  SB4    B6+
          GT     B6,B1,WTF13 IF MORE THAN 1 BUFFER NEEDED
          SB4    1
          NZ     X1,CPT      IF BUFFER ALREADY INTERLOCKED
          SX7    BMVI*100B+BMRW
          NG     X2,WTF14    IF REWRITE OF ONE BUFFER
 WTF13    SX7    BMVI*100B+BMWR
          ZR     X1,WTF14    IF NO INTERLOCKED BUFFER
          MX1    1           SET CURRENT BUFFER INTERLOCKED FLAG
          LX1    41-59
          BX7    X7+X1
 WTF14    SX2    B4-B1
          SX1    LSLB        LOGICAL SECTORS PER I/O BUFFER
          IX0    X2*X1       CHECK IF PRU COUNT OVERFLOW
          LX2    42
          IX0    X0+X1
          SA1    PRUC
          IX1    X1+X0
          AX1    12
          NZ     X1,RCR      IF PRU COUNT WILL EXCEED 12 BITS
          BX7    X7+X2       SET NUMBER OF I/O BUFFERS TO REQUEST
          SA7    WLBR
 
*         CALCULATE NUMBER OF I/O BUFFERS ON REMAINDER OF
*         CURRENT TRACK.
 
          SA2    A4+B1       GET SECTORS PER TRACK
          SX7    X2
          IX1    X7-X3       SECTOR LIMIT - FIRST SECTOR IN BUFFER
          PX1    X1
          FX1    X1/X6
          UX1,B6 X1
          LX1    B6
          SB6    X1+         NUMBER OF I/O BUFFERS REMAINING ON TRACK
          GE     B6,B4,WTF20 IF SUFFICIENT ROOM ON CURRENT TRACK
          MX0    -12
          ERX3   X4          GET CURRENT TRACK
          LX2    -18
          SX1    X2          MST ADDRESS
          SB6    WTF15       SET RETURN ADDRESS FOR *SNT*
          LX3    -24
          BX0    -X0*X3
          EQ     SNT         SET NEXT TRACK
 
 WTF15    SA3    B7+ACLW     CHECK FOR JOB PRU LIMIT
          NG     X2,WTF20    IF NEXT TRACK ASSIGNED
          ZR     B5,WTF20    IF UPDATE MODE
          MX2    -18
          SX7    /CIOERR/PRL *PRU LIMIT*
          BX2    -X2*X3
          SA3    FSZL        FILE SIZE LIMIT
          ZR     X2,RPC      IF JOB PRU LIMIT
 
*         CHECK FILE SIZE LIMIT.
 
          ZR     X3,WTF18    IF UNLIMITED
          BX2    X3
          AX2    30
          SA1    A4+B1       SECTORS PER TRACK
          SX1    X1
          NZ     X2,WTF17    IF FILE SIZE ALREADY CALCULATED
          SB4    WTF16       SET RETURN ADDRESS FOR *SRA*
          SB4    -B4         PREVENT SETTING RANDOM INDEX IN FET
          EQ     SRA         CALCULATE NUMBER OF SECTORS ON FILE
 
 WTF16    SA3    FSZL        FILE SIZE LIMIT
          SX1    B2
          IX6    X7+X1       SECTOR COUNT THRU END OF CURRENT TRACK
          LX6    30
          BX3    X3+X6
 WTF17    MX6    -30
          BX6    -X6*X3
          LX1    30          ADD IN SECTORS FOR NEW TRACK
          IX7    X1+X3
          SA7    A3+
          AX7    30
          IX6    X7-X6
          SX7    /CIOERR/FTL *FILE TOO LONG*
          PL     X6,RPC      IF FILE SIZE LIMIT EXCEEDED
 
*         REQUEST ADDITIONAL TRACK.
 
 WTF18    ERX1   X4          GET EQUIPMENT AND CURENT TRACK
          MX6    -12
          LX1    12
          BX6    -X6*X1
          LX1    12
          MX0    12
          BX1    X0*X1
          BX6    X1+X6
          LX6    36
          SX7    B1          REQUEST ONE TRACK
          BX6    X6+X7
          MX0    -5
          MONITOR  RTCM
          MX6    -12         CHECK TRACK ASSIGNMENT
          BX7    -X6*X1
          NZ     X7,WTF19    IF TRACK ASSIGNED
 
*         PROCESS TRACK LIMIT.
 
+         NG     X1,RCR1     IF *RTCM* REJECT
          EQ     RPC         CALL PP CIO TO COMPLETE REQUEST
 
*         INCREMENT MASS STORAGE PRU COUNT.
 
 WTF19    SA1    A4+B1       GET SECTORS PER TRACK
          SX1    X1
          SA2    PCMS
          IX6    X2+X1
          SA6    A2
          MX7    1
          LX7    10-59
          SA2    A4          CLEAR REWRITE FLAG
          BX7    -X7*X2
          SA7    A4+
 
*         CALL I/O BUFFER MANAGER.
 
 WTF20    SA2    WLBR        GET NUMBER OF I/O BUFFERS TO REQUEST
          SB4    WTF21       SET RETURN ADDRESS FOR *CIM*
          EQ     CIM         CALL I/O BUFFER MANAGER
 
 WTF21    SA2    A5+B1       CHECK IF MULTIPLE BUFFERS INTERLOCKED
          BX7    X7-X7
          NZ     X2,CPT      IF MORE THAN ONE BUFFER ASSIGNED
          SA2    WLBR
          SA0    WTF21.1     SET RETURN ADDRESS FOR *CMS*
          AX2    41
          ZR     X2,CPT      IF ONLY ONE BUFFER REQUESTED
          LX2    -1
          NG     X2,WTF21.2  IF NEXT BUFFER REQUIRED
          EQ     CMS         CALCULATE MOD 40B OF CURRENT SECTOR
 
 WTF21.1  SX1    X1-LSLB+LSLB/4
          NG     X1,CPT      IF CAN WRITE MORE DATA TO CURRENT BUFFER
 WTF21.2  SA2    A4          CHECK FOR REWRITE
          LX2    59-10
          PL     X2,RCR2     IF NOT REWRITE
          EQ     CPT         CALCULATE PRU-S TO TRANSFER
 
*         REENTRY FROM *CPT*.
*         CHECK IF ROOM FOR BLOCK WRITE AND EOI.
 
 WTF23    ERX1   X4          GET CURRENT SECTOR
          LX1    -12
          MX7    -12
          BX1    -X7*X1
          IX7    X1+X6       LAST SECTOR POSITION + 1 TO TRANSFER
          SA1    A4          CHECK FOR REWRITE
          MX6    1
          LX1    59-10
          SB4    B6          SAVE WORD COUNT
          BX6    -X6*X1
          PL     X1,WTF24    IF NOT REWRITE
          SA1    NTKP        GET NEXT TRACK POINTER
          IX1    X1-X7
          PL     X1,WTF25    IF NOT OVERWRITTING EOI SECTOR
          NZ     B5,WTF24    IF NOT UPDATE MODE
          SX7    /CIOERR/IFM *INCORRECT MODIFICATION*
          EQ     RPC         CALL *1MS*
 
 WTF24    SA1    A4+B1       SET WRITE EOI FLAG
          LX6    10-59
          SA6    A4+         CLEAR REWRITE FLAG
          MX6    1
          BX6    X1+X6
          SA6    A4+1
          SA1    LBIA        GET FIRST SECTOR OF CURRENT BUFFER
          AX1    30
          IX6    X7-X1       MOD 40B OF LAST SECTOR TO TRANSFER + 1
          SA1    A5+1        CHECK FOR MORE BUFFERS INTERLOCKED
          SX6    X6-LSLB
          NG     X6,WTF25    IF NOT OVERWRITE OF LAST SECTOR IN BUFFER
          ZR     X1,WTF8     IF MUST SAVE ROOM FOR EOI
 
*         ADVANCE CURRENT TRACK/SECTOR.
 
 WTF25    ERX1   X4          GET FST ENTRY
          MX6    48
          LX1    -12
          BX6    X6*X1
          SA2    A4+B1       GET SECTOR LIMIT
          BX6    X6+X7       SAVE ADVANCED SECTOR
          SX1    X2
          IX1    X7-X1
          NG     X1,WTF28    IF NOT AT END OF TRACK
          LX2    -18         GET SECTOR LIMIT
          SX1    X2          MST ADDRESS
          BX7    X0          SAVE I/O BUFFER DATA ADDRESS
          LX6    -12
          MX0    -12
          BX0    -X0*X6      CURRENT TRACK
          SB6    WTF26       SET RETURN ADDRESS FOR *SNT*
          EQ     SNT         SET NEXT TRACK
 
 WTF26    PL     X2,WTF26    IF NEXT TRACK NOT ASSIGNED
          SA6    NTKP        SAVE NEXT TRACK POINTER
          BX0    X6
          SB6    WTF27       SET RETURN ADDRESS FOR *SNT*
          EQ     SNT         SET NEXT TRACK
 
 WTF27    SA1    A6
          BX0    X7          RESTORE I/O BUFFER DATA ADDRESS
          SA6    A6+         SAVE OLD EOI SECTOR/NEXT TRACK POINTER
          BX7    X1
          MX6    48
          ERX1   X4          GET FST ENTRY
          LX1    -24
          BX1    X6*X1
          BX1    X1+X7       SET CURRENT TRACK
          LX1    12
          BX6    X6*X1       CLEAR CURRENT SECTOR
 
*         SET LINK IN HEADER IF LAST PRU IN SECTOR USED.
*         INCREMENT TOTAL PRU COUNT.
*         DECREMENT CIO BUFFER PRU COUNT AND WORD COUNT.
 
 WTF28    SA2    USCW        GET UPDATED SECTOR CONTROL WORD
          MX1    2
          LX1    23-59       CLEAR DATA FLAGS
          BX2    -X1*X2
          MX1    -LSLBS      CHECK IF LAST PRU IN BUFFER USED
          BX1    -X1*X6      MOD *LSLB* OF CURRENT SECTOR
          LX6    12
          SB6    X1
          BX1    X6
          BX6    X2
          MX2    48
          NZ     B6,WTF29    IF NOT WRITING LAST PRU IN BUFFER
          BX6    X2*X6       SET NEXT TRACK/SECTOR IN HEADER
          BX6    X6+X7
 WTF29    SA6    X3          STORE HEADER
          SX3    B2-/CIO/EOR
          MX6    56
          SA2    NPTR        GET NUMBER OF PRUS TO TRANSFER
          BX6    X6*X1       SET LAST OPERATION INCOMPLETE WRITE
          LX2    6
          SB6    X2-100B
          SX2    2
          BX6    X6+X2
          LX7    36          BUILD EOF TRAILER
          NG     X3,WTF31    IF FULL BLOCK TRANSFER
          SX1    B6+77B
          NZ     X3,WTF30    IF EOF TRANSFERRED
          SX3    B4-B6       CALCULATE WORD COUNT OF SHORT PRU
          LX7    12
          LX3    -24
          BX7    X7+X3
 WTF30    SA7    ERWB        PLACE TRAILER IN EXTENDED WRITE BUFFER
          SB6    A0+         SAVE (A0)
          BX7    X0          SAVE (X0)
          LX0    30
          SA0    A7          FWA TO BEGIN TRANSFER FROM
          AX0    30
          SX3    A7
          IX1    X0+X1
          LX3    30
          BX0    X1+X3       30/FWA FROM, 30/FWA I/O BUFFER DATA TO
          WE     1           TRANSFER ONE WORD
          RJ     HHE         HANG ON HALF-EXIT
          BX0    X7          RESTORE (X0)
          SA0    B6          RESTORE (A0)
          LX2    1           SET LAST OPERATION COMPLETE WRITE
          BX6    X6+X2
 WTF31    SA2    A2          GET NUMBER OF PRUS TO TRANSFER
          EWX6   X4
          SA1    PRUC        INCREMENT TOTAL PRU COUNT
          SA3    WCCB        DECREMENT CIO BUFFER WORD COUNT
          IX6    X1+X2
          SA6    A1
          SA1    NPCB        DECREMENT CIO BUFFER PRU COUNT
          SX7    B4
          IX7    X3-X7
          IX6    X1-X2
          PL     X6,WTF32    IF MORE PRUS IN CIO BUFFER
          BX6    X6-X6
 WTF32    SA6    A1
          SA7    A3
          SA1    SDTW        SKIP DATA TRANSFER FLAG FOR WRITE
          SA2    A4
          BX7    X2+X1       ADD SKIP FLAG
          SA7    A4
          LX2    59-5
          SA1    A5+3        GET *OUT*
          SX6    B4          SET WORD COUNT TO TRANSFER
          SX1    X1
          NG     X2,CWD      IF *WRITECW*
          SB6    WTF33       SET RETURN ADDRESS FOR *BWD*
          EQ     BWD         BUFFER WRITE DATA
 
*         REENTRY FROM *BWD*/*CWD*.
*         DATA TRANSFERRED FROM CIO BUFFER TO I/O BUFFER.
*         UPDATE *OUT* POINTER IN FET AND MESSAGE BUFFER.
 
 WTF33    SX3    B1+B1       UPDATE *OUT* IN FET
          SX6    X1
          MX2    36
          IX3    X5+X3
          SA1    A5+3        UPDATE *OUT* IN MESSAGE BUFFER
          SB6    WTF34       SET RETURN ADDRESS FOR *CSP*
          EWX6   X3
          BX2    X2*X1       *IN*
          BX6    X6+X2
          SA6    A1
          EQ     CSP         CALCULATE SECTOR POSITION
 
*         CHECK IF CURRENT SECTOR IN SAME I/O BUFFER.
 
 WTF34    SX2    BMRF*100B   RELEASE AND FLUSH WRITE BUFFER
          SB4    WTF36       SET RETURN ADDRESS FOR *CIM*
          NG     X7,CIM      IF SECTOR NOT IN SAME BUFFER
          SX7    X7-LSLB
          PL     X7,CIM      IF SECTOR NOT IN SAME BUFFER
          SB6    CPT         CALCULATE PRUS TO TRANSFER
 WTF35    SA2    A4          CHECK IF TERMINATION CONDITION REACHED
          SX6    14B
          BX6    X6*X2
          SB3    X6
          SB2    B2-B3
          PL     B2,CMP      IF TERMINATION CONDITION REACHED
          JP     B6          CONTINUE WRITE PROCESSING
 
 WTF36    SA2    A4          CHECK FOR REWRITE
          LX2    59-10
          PL     X2,WTF36.1  IF NOT REWRITE
          SA1    PMFF
          SB6    RCR2        EXIT ADDRESS IF OPERATION NOT COMPLETE
          ZR     X1,WTF35    IF DIRECT ACCESS PERMANENT FILE
 WTF36.1  ZR     X6,WTF37    IF NEXT BUFFER NOT INTERLOCKED
          SB6    CPT         CALCULATE PRUS TO TRANSFER
          NG     X2,WTF35    IF REWRITE
          SA1    A5+1
          NZ     X1,WTF35    IF ADDITIONAL I/O BUFFERS INTERLOCKED
 WTF37    SB6    WTF8        REQUEST MORE I/O BUFFERS
          EQ     WTF35       CHECK FOR TERMINATION CONDITION
 BWD      SPACE  4,15
**        BWD - BUFFER WRITE DATA.
*
*         ENTRY  (B6) = RETURN ADDRESS.
*                (X0) = FWA TO TRANSFER DATA IN I/O BUFFER.
*                (X1) = *OUT*.
*                (X6) = WORD COUNT TO TRANSFER.
*
*         EXIT   (X1) = ADVANCED *OUT* POINTER.
*                (B5) = FILE MODE - 1.
*
*         USES   A - 0, 1, 2.
*                B - 4, 5.
*                X - 0, 2, 3, 6, 7.
*
*         CALLS  ABP.
 
 
 BWD      ZR     X6,RB6      IF NO DATA TO TRANSFER
          SA2    ABRA        ABSOLUTE *RA*
          LX0    -30
          IX2    X1+X2       ABSOLUTE *OUT*
          SA0    X2
          BX0    X0+X2
          LX0    30          30/ABSOLUTE *OUT*, 30/FWA I/O BUFFER DATA
          SX7    X6
          SB4    BWD1        SET RETURN ADDRESS FOR *ABP*
          EQ     ABP         ADVANCE *OUT*
 
 BWD1     NG     X7,BWD4     IF NO SECOND PART TO TRANSFER
          IX6    X6-X7       NUMBER OF WORDS IN FIRST PART
          SX3    X2          RELATIVE *FIRST*
          SB4    X6          SET TRANSFER SIZE
          SB5    BTSZ
          BX2    X2-X2
          GE     B5,B4,BWD3  IF ONE BLOCK OR LESS TO WRITE
          SA2    PSTA        ADDRESS INCREMENT WORD
 BWD2     WE     BTSZ
          RJ     HHE         HANG ON HALF-EXIT
          SB5    B5+BTSZ     INCREMENT ADDRESSES
          SA0    A0+BTSZ
 BWD3     IX0    X0+X2
          LT     B5,B4,BWD2  IF MORE BLOCKS TO TRANSFER
          SB5    B4-B5
          WE     B5+BTSZ
          RJ     HHE         HANG ON HALF-EXIT
          MX2    -30
          SX6    B5+BTSZ     SET WORD COUNT OF LAST BLOCK
          BX0    -X2*X0      CLEAR CM ADDRESS FIELD
          IX0    X0+X6       ADVANCE I/O BUFFER ADDRESS
          SA2    ABRA        ABSOLUTE *RA*
          IX3    X3+X2       ABSOLUTE *FIRST*
          SA0    X3
          LX3    30
          BX0    X0+X3
          BX6    X7          SET BLOCK SIZE OF SECOND BLOCK
 BWD4     SB4    X6          SET TRANSFER SIZE
          SB5    BTSZ
          BX2    X2-X2
          GE     B5,B4,BWD6  IF .LE. ONE BLOCK TO TRANSFER
          SA2    PSTA
 BWD5     WE     BTSZ
          RJ     HHE         HANG ON HALF-EXIT
          SB5    B5+BTSZ
          SA0    A0+BTSZ     INCREMENT ADDRESSES
 BWD6     IX0    X0+X2
          LT     B5,B4,BWD5  IF MORE FULL BLOCKS TO TRANSFER
          SB5    B4-B5
          WE     B5+BTSZ
          RJ     HHE         HANG ON HALF-EXIT
          SA2    FMOD        RESTORE FILE MODE
          SB5    X2-1
          JP     B6          RETURN
 CWD      SPACE  4,15
**        CWD - CONTROL WORD WRITE DATA.
*
*         ENTRY  (X0) = FWA TO TRANSFER DATA IN I/O BUFFER.
*                (X1) = *OUT*.
*                (X6) = WORD COUNT TO TRANSFER.
*
*         EXIT   TO *WTF33*.
*                (X1) = ADVANCED *OUT* POINTER.
*
*         USES   A - 2, 3, 7.
*                B - 4, 6.
*                X - 0, 2, 3, 6, 7.
*
*         CALLS  ABP, BWD.
 
 
 CWD      SA2    NPTR        GET NUMBER OF PRUS TO TRANSFER
          SA3    WCCB        DECREMENT WORD COUNT OF *CIO* BUFFER
          LX2    1           COUNT CONTROL WORDS
          IX7    X3-X2
          SA7    A3
          BX3    X6          WORD COUNT OF TRANSFER
          SA2    NPTR
          ZR     X2,WTF33    IF TRANSFER COMPLETE
          SX6    B1
          IX7    X2-X6
          SA7    A2
          SX7    B1          SKIP OVER HEADER CONTROL WORD
          SB4    CWD2        SET RETURN ADDRESS FOR *ABP*
          EQ     ABP         ADVANCE *OUT*
 
 CWD2     LX6    6           SET FULL BLOCK WORD COUNT
          IX7    X0+X6       SAVE ADVANCED I/O BUFFER DATA ADDRESS
          SA7    CWLA
          IX3    X3-X6
          PL     X3,CWD3     IF FULL BLOCK
          IX6    X3+X6       SET SHORT BLOCK WORD COUNT
 CWD3     BX7    X3          SAVE WORD COUNT
          SB6    CWD4
          SA7    A7+B1
          EQ     BWD         WRITE DATA
 
 CWD4     SA2    CWLA        GET ADVANCED I/O BUFFER DATA ADDRESS
          SA3    A2+B1       GET WORD COUNT
          BX0    X2          RESET (X0)
          SA2    NPTR        WORD COUNT OF TRANSFER
          SB4    WTF33       SET EXIT ADDRESS
          SX7    B1
          ZR     X2,ABP      IF TRANSFER COMPLETE, ADVANCE OUT
          IX7    X2-X7       DECREMENT PRUS
          SA7    A2
          SB4    CWD2        SET RETURN ADDRESS
          SX7    B1+B1       SKIP TRAILER AND HEADER CONTROL WORDS
          SX6    B1
          EQ     ABP         ADVANCE *OUT*
 SCW      SPACE  4,30
**        SCW - SCAN CONTROL WORDS FOR *WRITECW*.
*
*         ENTRY  (B2) = MAXIMUM PRUS TO TRANSFER THIS PASS.
*                (B4) = MOD 10B OF CURRENT SECTOR.
*                (X0) = I/O BUFFER DATA FWA.
*                (X3) = ADDRESS OF CONTROL WORD.
*
*         EXIT   TO *CMP* IF TRANSFER TERMINATED DUE TO INSUFFICIENT
*                   DATA IN CIO BUFFER.
*                TO *CPT* IF MORE DATA AVAILABLE AFTER INSUFFICIENT
*                   DATA DETECTED.
*                TO *WTF23* IF PRUS TO TRANSFER.
*                (B2) = STATUS (0 = FULL BLOCK, 4 = EOR, 10B = EOF).
*                (B6) = WORD COUNT OF TRANSFER.
*                (X0) AND (X3) RESTORED TO SAME AS ON ENTRY.
*                (X6) = (NPTR) = NUMBER OF PRUS TO TRANSFER
*                   THIS PASS (1 TO 10B).
*
*         ERROR  TO *RPC* IF BUFFER CONTROL WORD ERROR.
*
*         USES   A - 0, 2, 3, 6, 7.
*                B - 2, 3, 4, 6.
*                X - 0, 1, 2, 3, 6, 7.
*
*         CALLS  ABP, CBS.
 
 
 SCW      SA2    X3          GET HEADER WORD
          BX6    X2
          SA6    USCW        SAVE UPDATED SECTOR CONTROL WORD
          LX0    30
          SA2    A5+B1
          SB3    B4-LSLB/4
          SA0    B4          MOD 10B OF CURRENT SECTOR
          NZ     X2,SCW0     IF NEXT BUFFER RESERVED
          SB2    -B3         LIMIT TRANSFER TO PRESERVE ROOM FOR EOI
 SCW0     BX0    X3+X0       SAVE (X3) AND (X0)
          SA3    A5+3        GET *OUT*
          BX6    X6-X6       CLEAR NUMBER OF PRUS TO TRANSFER
          SX1    X3
 SCW1     SA2    WCCB        GET WORD COUNT OF *CIO* BUFFER
          LX3    X6,B1
          LX6    6
          IX3    X3+X6       NUMBER OF WORDS TO TRANSFER
          LX6    -6
          SB4    X2
          IX3    X2-X3
          SA2    ABRA        ABSOLUTE *RA*
          ZR     X3,SCW7     IF NO MORE DATA IN BUFFER
          IX2    X2+X1
          MX7    -12
          ERX2   X2          GET HEADER CONTROL WORD
          BX2    -X7*X2      BYTE COUNT
          SX7    X2-500B
          NZ     X7,SCW4     IF NOT FULL BLOCK
          SX3    X3-102B
          NG     X3,SCW7     IF NOT ENOUGH DATA IN BUFFER
          SX6    X6+B1       INCREMENT NUMBER OF SECTORS TO TRANSFER
          SB6    A0
          SA2    USCW        UPDATE SECTOR CONTROL WORD
          SB4    LSLB/4
          NE     B6,B4,SCW1.1  IF PRU NOT IN NEXT CONTROL WORD
          BX7    X2          STORE SECTOR CONTROL WORD IN BUFFER
          SB6    B0
          SA7    X0
          SA2    A7+B1       GET NEXT SECTOR CONTROL WORD
          SX3    B1          INCREMENT SECTOR CONTROL WORD ADDRESS
          SA0    B0+
          IX0    X0+X3
 SCW1.1   SX7    10000B      BUILD SECTOR MASK
          LX7    B6
          SA0    A0+B1
          BX7    -X7*X2      CLEAR SHORT PRU FLAG
          SX3    B2+
          IX3    X3-X6
          SA7    USCW        SAVE UPDATED SECTOR CONTROL WORD
          SX7    102B        SET NUMBER OF WORDS TO ADVANCE
          SB4    SCW1        SET RETURN ADDRESS FOR *ABP*
          NZ     X3,ABP      IF MORE PRUS TO TRANSFER
 SCW2     LX6    6
          SB6    X6          WORD COUNT TO TRANSFER
          SB2    B0          SET FULL BLOCK INDICATOR
          LX6    -6
 SCW3     MX1    -30
          BX3    -X1*X0      RESTORE (X0) AND (X3)
          SA6    NPTR        SAVE NUMBER OF PRUS TO TRANSFER
          AX0    30
          EQ     WTF23       RETURN TO MAIN WRITE LOOP
 
 SCW4     PL     X7,SCW6     IF BYTE COUNT .GT. 500B
          SX7    5
          PX7    X7
          PX2    X2
          NX7    X7
          FX7    X2/X7
          UX7,B6 X7
          LX7    B6
          SX2    X7+2
          IX3    X3-X2
          NG     X3,SCW7     IF NOT ENOUGH DATA IN BUFFER
          SB3    X7
          SA2    USCW        GET UPDATED SECTOR CONTROL WORD
          SB4    LSLB/4
          SX3    B1
          SB6    A0
          NE     B6,B4,SCW4.1  IF PRU NOT IN NEXT CONTROL WORD
          BX7    X2          STORE SECTOR CONTROL WORD IN BUFFER
          SA0    B0
          SA7    X0
          SA2    A7+B1       GET NEXT SECTOR CONTROL WORD
          IX0    X0+X3
          SB6    B0
 SCW4.1   LX3    12
          LX3    B6
          BX7    X2+X3       SET SHORT PRU FLAG
          SA7    USCW        SAVE UPDATED SECTOR CONTROL WORD
          LX6    6
          SB6    X6+B3       WORD COUNT OF TRANSFER
          LX6    -6
          SX6    X6+B1       INCREMENT NUMBER OF SECTORS TO TRANSFER
          SB2    /CIO/EOR    SET EOR STATUS
          NZ     B3,SCW3     IF DATA IN BLOCK
          SB4    SCW5        SET RETURN ADDRESS FOR *ABP*
          SX7    1           SET NUMBER OF WORDS TO ADVANCE
          EQ     ABP         ADVANCE *OUT*
 
 SCW5     SA2    ABRA        *RA*
          IX2    X2+X1
          MX7    -4
          ERX2   X2          GET TRAILER CONTROL WORD
          MX7    -4
          LX2    12
          BX7    X7+X2
          NZ     X7,SCW3     IF NOT LEVEL 17B
          SB2    /CIO/EOF    SET EOF STATUS
          EQ     SCW3        RESTORE ENTRY CONDITIONS
 
 SCW6     SX7    /CIOERR/BLE *BUFFER CONTROL WORD ERROR*
          EQ     RPC         CALL PP CIO
 
*         PROCESS INSUFFICIENT DATA IN CIO BUFFER.
 
 SCW7     NZ     X6,SCW2     IF SECTORS TO TRANSFER
          SB6    SCW8        SET RETURN ADDRESS FOR *CBS*
          EQ     CBS         CHECK BUFFER SPACE
 
 SCW8     SX1    B4
          IX7    X1-X7
          NG     X7,CPT      IF MORE DATA IN BUFFER
          EQ     CMP         COMPLETE WRITE PROCESSING
          TITLE  CIO PROCESSOR SUBROUTINES.
 ABP      SPACE  4,15
**        ABP - ADVANCE BUFFER POINTERS.
*
*         ENTRY  (B4) = RETURN ADDRESS.
*                (X1) = *IN* OR *OUT* POINTER TO BE ADVANCED.
*                (X7) = NUMBER OF WORDS TO TRANSFER.
*
*         EXIT   (X1) = ADVANCED *IN* OR *OUT* POINTER.
*                (X2) = *FIRST* POINTER IN BITS 0 - 17.
*                (X7) = NUMBER OF WORDS TO TRANSFER AFTER WRAP-AROUND
*                   IF .GT. 0.
*
*         USES   A - 2.
*                X - 1, 2, 7.
 
 
 ABP      SA2    A4-B1       GET *FIRST* AND *LIMIT*
          SX2    X2          *LIMIT*
          IX2    X2-X1       NUMBER OF WORDS IN BUFFER BEFORE WRAP
          IX1    X1+X7       ADVANCE *IN* OR *OUT* POINTER
          IX7    X7-X2       NUMBER OF WORDS TO TRANSFER AFTER WRAP
          SA2    A4-1        GET *FIRST*
          LX2    -24
          SX2    X2
          NG     X7,RB4      IF NO WRAP AROUND
          SX1    X2          SET *IN* OR *OUT* = *FIRST*
          IX1    X1+X7       ADVANCE *IN* OR *OUT* POINTER
          NZ     X7,RB4      IF DATA IN SECOND PART
          SX7    -B1         INDICATE NO SECOND PART OF TRANSFER
          JP     B4          RETURN
 CBS      SPACE  4,15
**        CBS - CHECK BUFFER SPACE.
*
*         ENTRY  (B6) = RETURN ADDRESS.
*
*         EXIT   (X6) = (NPCB) = BUFFER SIZE IN PRUS.
*                (X7) = (WCCB) = WORD COUNT OF DATA IN BUFFER
*                   IF WRITE, ROOM REMAINING IN BUFFER IF READ.
*
*         ERROR  TO *RPC* IF BUFFER ARGUMENT ERROR.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 2, 3.
*                X - 0, 1, 2, 3, 6, 7.
 
 
 CBS      SX2    B1+B1       GET *OUT* FROM FET
          IX2    X5+X2
          ERX2   X2
          SB2    X2
          SA2    A4          GET MESSAGE BUFFER PARAMETERS
          SX6    B2
          SA3    A4-B1       GET FIRST AND LIMIT FROM MESSAGE BUFFER
          LX2    59-6
          SA1    A3-B1       GET *IN* FROM MESSAGE BUFFER
          SX0    X3          LIMIT
          AX3    24
          SX3    X3          FIRST
          SB3    X3
          PL     X2,CBS1     IF READ
          SB2    X1          GET *OUT* FROM MESSAGE BUFFER
          SX1    1           GET *IN* FROM FET
          IX1    X5+X1
          ERX1   X1
          SX1    X1+
          BX6    X1
          LX1    24
 CBS1     IX7    X6-X3       REVALIDATE IN OR OUT POINTER
          NG     X7,CBS5     IF POINTER .LT. FIRST
          IX7    X6-X0
          PL     X7,CBS5     IF POINTER .GE. LIMIT
          AX1    24
          IX0    X0-X3       LIMIT - FIRST
          LX1    24
          SX3    B2
          BX7    X1+X3       UPDATE MESSAGE BUFFER *IN* AND *OUT*
          SA7    A3-B1
          LX1    -24
          IX7    X1-X3       *IN* - *OUT*
          SX1    X1+1        *IN* + 1
          NG     X2,CBS2     IF WRITE FUNCTION
          IX7    X3-X1       *OUT* - *IN* - 1
 CBS2     PL     X7,CBS3     IF NO BUFFER WRAP REQUIRED
          IX7    X0+X7
 CBS3     SA7    WCCB        SAVE WORD COUNT
          BX6    X7          CALCULATE BUFFER SIZE IN PRUS
          LX2    59-5-59+6
          AX6    6
          PL     X2,CBS4     IF NOT *READCW*/*WRITECW*
          SX6    102B
          PX1    X7
          PX6    X6
          NX6    X6
          FX6    X1/X6
          UX6    B2,X6
          LX6    B2
 CBS4     SA6    NPCB        SAVE BUFFER SIZE IN PRUS
          JP     B6          RETURN
 
 CBS5     SX7    /CIOERR/BUF *BUFFER ARGUMENT ERROR*
          EQ     RPC         CALL PP CIO
 CIM      SPACE  4,25
**        CIM - CALL I/O BUFFER MANAGER.
*
*         ENTRY  (B4) = RETURN ADDRESS.
*                (X2) = 12/0,6/NBI,1/I,29/0,6/OP,6/BC.
*                       NBI = NUMBER OF ADDITIONAL WRITE BUFFERS
*                          TO INTERLOCK.
*                       I = SET IF CURRENT WRITE BUFFER INTERLOCKED.
*                       OP = I/O BUFFER MANAGER OPERATION.
*                       BC = BUFFER COUNT (OP = BMRD) OR
*                          INTERLOCK MODE (OP = BMVI).
*
*         EXIT   (X6) = FWA CONTROL BUFFER IF INTERLOCKED.
*                (LBIA) = INTERLOCKED BUFFER ADDRESS IF NONZERO.
*
*         ERROR  TO *RCR2* IF I/O BUFFER BUSY.
*                TO *RCR3* IF I/O BUFFER RECALL.
*                TO *RPC* IF I/O ERROR, ADDRESS ERROR OR INACCESSIBLE
*                   DEVICE.
*
*         USES   A - 0, 1, 2, 3, 6, 7.
*                B - 3.
*                X - 0, 1, 2, 3, 6, 7.
*
*         CALLS  CMS.
*
*         MACROS MONITOR.
 
 
 CIM      SA3    A4          GET FNT ORDINAL
          MX0    -12
          LX3    -24
          BX6    -X0*X3
          SA3    LBIA
          BX7    X7-X7
          SA7    A3          CLEAR BUFFER INTERLOCK ADDRESS
          SX1    B7          GET CONTROL POINT NUMBER
          LX1    18-7
          BX6    X1+X6
          LX6    12
          BX6    X6+X2
          MONITOR  BFMM
          SX2    X2+
          SB3    X2-BMFO*100B
          SX2    B1          GET FNT+2 WORD
          LX1    -12
          IX2    X4+X2
          BX6    -X0*X1      I/O BUFFER LINK
          ERX1   X2
          BX7    X0*X1
          BX7    X7+X6
          EWX7   X2
          BX7    X1
          SA1    A5+
          LX1    -12
          NG     B3,CIM0     IF NOT A FLUSH OPERATION
          SX6    B0+
 CIM0     NG     X1,CIM2     IF RECALL STATUS
          LX3    X1,B1
          BX7    X7-X7
          NG     X3,RCR2     IF I/O BUFFER BUSY
          AX3    56
          SA1    A5+B1       CHECK FOR MULTIPLE WRITE BUFFERS
          SB3    X3+         SAVE BUFFER MANAGER STATUS
          SA0    CIM1        SET RETURN ADDRESS FOR *CMS*
          NZ     X6,CMS      IF LINK RETURNED
          ZR     X1,CIM1.1   IF NO ALTERNATE BUFFER
          BX6    -X0*X1
          BX7    X0*X1
          LX7    -12
          SA7    A1
          ERX1   X2
          BX1    X0*X1
          BX7    X1+X6       SET I/O BUFFER LINK IN FNT
          EWX7   X2
          SA1    A5+B1
          SA2    A1+B1
          NZ     X1,CMS      IF MORE ALTERNATE BUFFERS
          BX7    X1
          SA7    A2
          BX7    X2
          SA7    A1
          EQ     CMS         CALCULATE FIRST SECTOR OF BUFFER
 
 CIM1     LX6    CBTLS       SET INTERLOCKED BUFFER ADDRESS
          LX3    30
          TX6    X6,CBT
          BX6    X6+X3
          SA6    A3+
          BX7    X7-X7
 CIM1.1   NZ     B3,RPC      IF INACCESSIBLE DEVICE OR ERROR
          JP     B4          RETURN
 
*         CHECK FOR RECALL ON FIRST OR SECOND I/O BUFFER.
 
 CIM2     SA1    A5+B1
          ZR     X1,RCR3     IF RECALL ON FIRST BUFFER
          EWX7   X2
          ZR     X3,RCR3     IF FIRST BUFFER NOT INITIALLY INTERLOCKED
          BX7    X3          RESET INTERLOCKED BUFFER ADDRESS
          SA7    A3
          BX7    X7-X7       CLEAR ORDINAL FROM MESSAGE BUFFER
          SA7    A5+B1
          EQ     RCR3        ENTER RECALL STACK
 
 CMS      SPACE  4,15
**        CMS - CALCULATE MOD 40B OF CURRENT SECTOR.
*
*         ENTRY  (A0) = RETURN ADDRESS.
*
*         EXIT   (X1) = MOD 40B OF CURRENT SECTOR.
*                (X2) = LSLB = 40B.
*                (X3) = FIRST SECTOR IN CURRENT I/O BUFFER.
*
*         USES   A - 1.
*                B - 6.
*                X - 0, 1, 2, 3.
 
 
 CMS      ERX1   X4          GET CURRENT SECTOR
          MX0    -12
          SX2    LSLB        LOGICAL SECTORS PER I/O BUFFER
          LX1    -12
          BX1    -X0*X1
          SB6    A0+         GET RETURN ADDRESS
          BX3    X1
          MX1    -LSLBS      CALCULATE MOD 40B OF CURRENT SECTOR
          BX1    -X1*X3
          IX3    X3-X1       CALCULATE FIRST SECTOR
          JP     B6          RETURN
 CPT      SPACE  4,20
**        CPT - CALCULATE PRUS TO TRANSFER.
*
*         EXIT   TO *CMP* IF NO PRUS TO WRITE.
*                TO *RDF6* IF READ OPERATION.
*                TO *WTF23* IF PRUS TO WRITE.
*                TO *RPC* IF PRU SIZE ERROR.
*                (B2) = STATUS (0 = FULL BLOCK, 4 = EOR,
*                   10B = EOF, 14B = EOI).
*                (B6) = WORD COUNT OF TRANSFER.
*                (X0) = FWA DATA IN I/O BUFFER.
*                (X2) = (USCW) = SECTOR CONTROL WORD (UPDATED FOR
*                                WRITE).
*                (X3) = ADDRESS OF LAST ACCESSED SECTOR CONTROL WORD.
*                (B3) = (X6) = (NPTR) = NUMBER OF PRUS TO TRANSFER.
*                (SDTW) = 0, EXCEPT BIT 56 IS SET FOR SKIP DATA
*                            TRANSFER FLAG ON WRITE OPERATION.
*                (USCW) = LAST ACCESSED SECTOR CONTROL WORD.
*
*         USES   A - 1, 2, 6, 7.
*                B - 2, 3, 4, 6.
*                X - 1, 2, 6, 7.
*
*         CALLS  CBS, CSA, SCW.
 
 
 CPT12    ZR     X6,CMP      IF NO DATA IN BUFFER
 
 CPT      SB4    CPT1        SET RETURN ADDRESS FOR *CSA*
          EQ     CSA         CALCULATE SECTOR ADDRESS IN I/O BUFFER
 
 CPT1     SA2    A4
          SB2    X7-LSLB     COMPLEMENT OF MAXIMUM PRUS TO TRANSFER
          BX7    X7-X7       CLEAR SKIP FLAG DATA TRANSFER ON WRITE
          SB2    -B2         MAXIMUM PRUS TO TRANSFER
          SA7    SDTW
          LX2    59-6
          SB4    B3+         MOD 10B OF CURRENT SECTOR
          SA1    NPCB        GET NUMBER OF PRUS IN BUFFER
          PL     X2,CPT4     IF READ/SKIP
          LX2    59-5-59+6
          SB3    X1
          NG     X2,SCW      IF *WRITECW*
          SB6    -B2
          SX7    X1+B6
          NG     X7,CPT2     IF WILL NOT REACH LAST SECTOR IN BUFFER
          SA1    A5+B1
          SB3    B2
          NZ     X1,CPT2     IF ANOTHER BUFFER RESERVED
          SB6    LSLB/4      LIMIT TRANSFER TO SAVE SPACE FOR EOI
          LE     B3,B6,CPT2  IF NO SWITCH OF SECTOR CONTROL WORD
          SB3    B6-B4       DO NOT ALLOW SWITCH OF CONTROL WORDS
          SB2    B6-B4
 CPT2     SX7    B5          SAVE (B5)
          PX7    X7,B3       SAVE (B3)
          SB5    LSLB/4
 CPT2.1   SB6    B5-B4       (B6) = REMAINING PRUS IN CONTROL WORD
          GE     B3,B6,CPT2.2  IF MULTIPLE SECTOR CONTROL WORDS
          SB6    B3          SET PRUS
 CPT2.2   SB3    B3-B6       DECREMENT PRUS
          MX1    1
          SB6    B6-B1
          SA2    X3          READ SECTOR CONTROL WORD
          AX1    B6          MASK TO CLEAR SHORT PRU FLAGS
          SB6    B6+B4       SKIP PRUS ALREADY WRITTEN
          SB6    B6+B1
          LX1    B6
          LX1    12
          BX2    -X1*X2      CLEAR SHORT PRU FLAGS
          ZR     B3,CPT2.3   IF ALL PRUS PROCESSED
          MX1    2           IGNORE DATA FLAGS
          LX1    23-59
          BX6    -X1*X2
          SX3    X3+B1       INCREMENT TO NEXT SECTOR CONTROL WORD
          SA6    A2          STORE SECTOR CONTROL WORD
          SB4    B0
          EQ     CPT2.1      UPDATE NEXT WORD
 
 CPT2.3   SB5    X7          RESTORE (B5)
          UX7,B3 X7          RESTORE (B3)
          SX7    14B         GET TERMINATION CONDITION
          SA1    A4
          BX7    X7*X1
          SX7    X7-/CIO/EOI
          SB4    WTF23       SET RETURN ADDRESS
          NZ     X7,CPT3     IF EOR/EOF OPERATION
          NZ     B3,CPT8     IF SECTORS TO TRANSFER
          SB6    CPT12       SET RETURN ADDRESS FOR *CBS*
          EQ     CBS         CHECK BUFFER SPACE
 
*         PROCESS SHORT BLOCK FOR EOR/EOF WRITE.
 
 CPT3     SB2    B2-B3
          ZR     B2,CPT8     IF MAXIMUM PRU TRANSFER
          MX7    1
          LX6    X7,B6
          LX6    13
          SB2    B6-LSLB/4
          NZ     B2,CPT3.1   IF NOT END OF SECTOR CONTROL WORD
          MX1    4           CLEAR PARITY ERROR AND IGNORE DATA FLAGS
          LX1    23-59
          BX6    -X1*X2
          SX3    X3+B1       INCREMENT TO NEXT SECTOR CONTROL WORD
          SA6    A2          STORE SECTOR CONTROL WORD
          SA2    A2+B1       READ NEXT SECTOR CONTROL WORD
          SX6    10000B
 CPT3.1   BX2    X2+X6       SET SHORT PRU FLAG IN HEADER
          SB3    B3+B1       INCREMENT NUMBER OF PRUS TO TRANSFER
          SA1    WCCB        GET WORD COUNT OF *CIO* BUFFER
          SB6    X1          NUMBER OF WORDS TO TRANSFER
          SA1    A4
          SB2    /CIO/EOF    SET EOF STATUS
          LX1    59-56
          LX7    56-59
          NG     X1,CPT9     IF PROCESSING EOF FOR *WRITEF*
          SB2    /CIO/EOR    SET EOR STATUS AND SKIP FLAG
          SA7    SDTW        SET SKIP FLAG
          EQ     CPT9        EXIT
 
*         PROCESS READ AND SKIP OPERATIONS.
 
 CPT4     LX2    59-56-59+6
          SX7    B1          BUILD SHORT PRU MASK
          LX7    12-1+59-19
          LX7    B4
          NG     X2,CPT6     IF SKIP DATA TRANSFER
          LX2    0-2-59+56
          MX6    -2
          BX6    -X6*X2      GET TERMINATION CONDITION
          NZ     X6,CPT5     IF NOT *RPHRLS*
          SB2    B1          LIMIT TRANSFER TO ONE PRU
 CPT5     SB4    -B2
          SX6    X1+B4
          PL     X6,CPT6     IF ENOUGH ROOM IN BUFFER FOR ALL PRUS
          SB2    X1+         TERMINATE TRANSFER ON FULL BUFFER
 CPT6     SA2    X3
          SB3    B2
          SB4    RDF6        SET RETURN ADDRESS
 
*         SCAN SHORT PRU FLAGS FOR EOR/EOF/EOI.
 
 CPT7     LX7    1-59+19     CHECK EOR FLAG
          BX1    X7*X2
          NZ     X1,CPT10    IF SHORT PRU
          SB2    B2-B1
          LX7    59-19
          ZR     B2,CPT8     IF ALL PRUS CHECKED
          PL     X7,CPT7     IF NOT END OF SECTOR CONTROL WORD
          SA2    A2+B1       READ NEXT SECTOR CONTROL WORD
          SX7    B1
          SX3    A2
          LX7    12-1+59-19
          EQ     CPT7        CHECK NEXT SECTOR CONTROL WORD
 
 CPT8     SX6    B3
          LX6    6
          SB6    X6
          SB2    B0
 CPT9     SX6    B3          SAVE NUMBER OF PRUS TO TRANSFER
          BX7    X2          SAVE SECTOR CONTROL WORD
          SA6    NPTR
          SA7    USCW
          JP     B4          EXIT
 
*         PROCESS SHORT PRU ON READ/SKIP OPERATION.
 
 CPT10    SB3    B3-B2       NUMBER OF FULL PRUS
          SX6    B3
          LX6    6
          SB6    X6          WORD COUNT OF FULL PRUS
          MX7    -12
          SX1    X6+77B      GET HEADER WORD FROM LAST DATA WORD
          IX1    X0+X1
          BX6    X0          SAVE (X0)
          SB2    A0          SAVE (A0)
          SA0    ERWB        READ HEADER WORD
          SX0    A0+
          LX0    30
          BX0    X0+X1
          RE     1           TRANSFER ONE WORD OF DATA
          RJ     HHE         HANG ON HALF-EXIT
          SA0    B2          RESTORE (A0)
          BX0    X6          RESTORE (X0)
          SA1    ERWB        GET HEADER WORD
          LX1    12
          SB3    B3+B1       TERMINATE TRANSFER ON SHORT PRU
          BX7    -X7*X1
          AX1    48
          ZR     X7,CPT11    IF EOF/EOI
          SX6    X1-100B
          SB6    B6+X1       ADD WORD COUNT OF SHORT PRU
          SX7    /CIOERR/DRE DEVICE ERROR
          PL     X6,RPC      IF PRU SIZE ERROR CALL *1MS*
          NG     X1,RPC      IF PRU SIZE ERROR CALL *1MS*
          SB2    /CIO/EOR    SET EOR STATUS
          EQ     CPT9        EXIT
 
 CPT11    SB2    /CIO/EOF    SET EOF STATUS
          NZ     X1,CPT9     IF EOF
          SB2    /CIO/EOI    SET EOI STATUS
          SB3    B3-1        RESET PRU COUNT TO PRECEED EOI
          EQ     CPT9        EXIT
 CSA      SPACE  4,15
**        CSA - CALCULATE SECTOR ADDRESS IN I/O BUFFER.
*
*         ENTRY  (B4) = RETURN ADDRESS.
*
*         EXIT   (X0) = FWA DATA IN I/O BUFFER.
*                (X3) = ADDRESS OF SECTOR CONTROL WORD IN I/O
*                       BUFFER.
*                (X6) = (B3) = MOD 10B OF CURRENT SECTOR.
*                (X7) = CURRENT SECTOR - FIRST SECTOR IN BUFFER.
*
*         USES   A - 2.
*                B - 3, 6.
*                X - 0, 2, 3, 6, 7.
*
*         CALLS  CSP.
 
 
 CSA      SB6    CSA1        SET RETURN ADDRESS FOR *CSP*
          EQ     CSP         CALCULATE CURRENT SECTOR POSITION
 
 CSA1     SX0    X3+IOLK
          SA2    X0+
          IX3    X3+X6       SECTOR CONTROL WORD ADDRESS
          MX6    -24
          BX0    -X6*X2      FWA I/O BUFFER
          MX6    -3
          BX6    -X6*X7      MOD 10B OF CURRENT SECTOR
          SB3    X6
          LX7    6
          IX0    X0+X7       FWA CURRENT SECTOR IN I/O BUFFER
          LX7    -6
          JP     B4          RETURN
 CSP      SPACE  4,15
**        CSP - CALCULATE SECTOR POSITION IN I/O BUFFER.
*
*         ENTRY  (B6) = RETURN ADDRESS.
*
*         EXIT   (X1) = CURRENT SECTOR.
*                (X3) = FWA CONTROL BUFFER.
*                (X6) = (B3) = SECTOR CONTROL WORD INDEX IN CONTROL
*                              BUFFER.
*                (X7) = CURRENT SECTOR - FIRST SECTOR IN BUFFER.
*
*         USES   A - 1, 3.
*                B - 3.
*                X - 1, 2, 3, 6, 7.
 
 
 CSP      SA3    LBIA        GET FWA INTERLOCKED I/O BUFFER
          ERX1   X4          GET CURRENT SECTOR
          MX6    -12
          BX2    X3
          LX1    -12
          AX2    30
          BX1    -X6*X1
          IX7    X1-X2       CURRENT SECTOR - FIRST SECTOR
          MX2    -24
          BX3    -X2*X3
          SX6    X7          INCREMENT FOR SECTOR CONTROL WORD
          AX6    CBTLS
          SB3    X6
          JP     B6          RETURN
 IMF      SPACE  4,15
**        IMF - ISSUE CPU MONITOR FUNCTION.
*
*         ENTRY  (B6) = RETURN ADDRESS.
*                (X1) = FUNCTION CODE.
*                (X6) = FUNCTION PARAMETERS.
*
*         EXIT   (X1) = FUNCTION REPLY.
*                (X6) = 0.
*
*         ERROR  ADVANCE EXIT TO (B6)+1 IF FUNCTION REJECT.
*
*         USES   A - 1, 6.
*                B - 6.
*                X - 1, 6.
 
 
 IMF      LX1    -12         ENTER REQUEST IN PSEUDO OUTPUT REGISTER
          BX6    X6+X1
          SA6    A5+
          XJ
 
 IMF1     SA1    A5+         CHECK OUTPUT REGISTER
          NG     X1,IMF2     IF REQUEST REJECTED
          LX1    59-56
          NG     X1,IMF2     IF REQUEST REJECTED
          LX1    56-59
          MX6    12
          BX6    X6*X1
          NZ     X6,IMF1     IF NOT CLEARED
          JP     B6          RETURN
 
 IMF2     SB6    B6+B1       ADVANCE EXIT FOR FUNCTION REJECT
          JP     B6          RETURN
 SRA      SPACE  4,15
**        SRA - SET RANDOM ADDRESS FOR CURRENT TRACK/SECTOR.
*
*         ENTRY  (B4) = RETURN ADDRESS.
*                (B4) = COMPLEMENT OF RETURN ADDRESS IF NOT TO
*                       CALL *RRI*.
*
*         EXIT   TO *CRA*.
*                (X3) = 12/ CURRENT TRACK, 36/ 0, 12/ CURRENT SECTOR.
*
*         USES   A - 1.
*                X - 1, 3, 6.
 
 
 SRA      ERX1   X4          GET CURRENT TRACK AND SECTOR
          MX6    -12
          LX1    -12
          BX3    -X6*X1
          LX1    -12
          BX6    -X6*X1
          LX6    -12
          BX3    X3+X6
*         EQ     CRA         COMPUTE RANDOM ADDRESS
 CRA      SPACE  4,25
**        CRA - CONVERT/COMPUTE RANDOM ADDRESS.
*
*         ENTRY  (B4) = RETURN ADDRESS.
*                (B4) = COMPLEMENT OF RETURN ADDRESS, IF TO RETURN
*                       RANDOM ADDRESS WITHOUT UPDATING FST/FET.
*                (X3) = 0 IF POSITION TO EOI AND RETURN RANDOM
*                   ADDRESS FOR EOI.
*                (X3) .GT. 0 IF RANDOM ADDRESS TO BE CONVERTED
*                   AND POSITIONED TO.
*                (X3) .LT. 0 IF RETURN RANDOM ADDRESS FOR SPECIFIED
*                   TRACK AND SECTOR (12/TRACK, 36/0, 12/SECTOR).
*
*         EXIT   TO *SFP* FOR UPDATE OF FST CURRENT TRACK AND SECTOR
*                   TO POSITION FOR RANDOM ADDRESS.
*                TO *RRI* TO SET RANDOM INDEX IN FET.
*                (B2) = SECTORS PER TRACK.
*                (X3) = RANDOM ADDRESS OF POSITION.
*                (X7) = SECTORS ON FILE BEFORE CURRENT TRACK FOR *SRA*
*                       CALL.
*
*         ERROR  TO *RPC* IF INCORRECT RANDOM ADDRESS.
*
*         USES   A - 1, 2, 6.
*                B - 2, 3, 4, 6.
*                X - 0, 1, 2, 3, 6, 7.
 
 
 CRA      ERX1   X4          GET FST ENTRY
          MX6    12
          LX1    24
          MX7    -2
          BX0    X6*X1       EXTRACT CURRENT TRACK
          LX1    -12
          ZR     X0,CRA12    IF FILE NOT USED
          BX1    X6*X1       EXTRACT FIRST TRACK
          SA2    A4+B1       GET MST ADDRESS AND SECTORS PER TRACK
          SB6    B0          PRESET TRACK COUNT
          LX2    -18
          SA2    X2+TRLL     SET TRT BASE ADDRESS
          SB3    X2-4000B/4
          SA2    A4+1        SET SECTORS PER TRACK
          NZ     X3,CRA3     IF NOT SKIP TO EOI
 
*         PROCESS SKIP TO EOI.
 
 CRA1     BX0    X6*X1       EXTRACT LINK
          LX0    10
          SB6    B6+B1
          SA1    B3+X0       READ TRT WORD
          LX0    2
          BX2    -X7*X0      EXTRACT BYTE
          LX2    2           BYTE * 4
          LX3    X2,B1       BYTE * 8
          IX2    X3+X2       BYTE * 12
          SB2    X2+
          LX1    X1,B2       POSITION TRACK BYTE
          NG     X1,CRA1     IF NOT END OF TRACK CHAIN
          BX7    X1
          SA1    A4+B1       GET SECTORS PER TRACK
          SX3    B6-1
          AX7    48
          SX1    X1
          IX3    X3*X1
          IX3    X3+X7
 CRA2     SB2    X1
          PL     B4,SFP      IF SETTING FST
          SB3    -B4
          JP     B3
 
*         PROCESS POSITION TO RANDOM ADDRESS.
 
 CRA3     NG     X3,CRA7     IF RETURNING RANDOM ADDRESS
          SX6    X2
          SX2    X2          SECTORS PER TRACK
 
*         IX2    X3/X2       SECTORS / SECTORS PER TRACK
          PX2    X2
          PX3    X3
          NX2    X2
          FX2    X3/X2
          UX3    X3
          UX2,B6 X2
          LX2    B6
 
          IX6    X2*X6       CALCULATE SECTOR NUMBER IN LAST TRACK
          IX6    X3-X6
          SA6    CRAA
          MX6    12
          SB6    X2+B1
 
*         SCAN TRT.
 
 CRA4     BX0    X6*X1       EXTRACT TRACK
          LX1    12
          LX0    10
          BX1    -X7*X1      EXTRACT BYTE POSITION
          LX1    2           BYTE * 4
          LX2    X1,B1       BYTE * 8
          IX2    X1+X2       BYTE * 12
          SA1    B3+X0       READ TRT WORD
          SB6    B6-1        DECREMENT TRACK COUNT
          SB2    X2
          LX1    X1,B2
          ZR     B6,CRA5     IF TRACK REACHED
          NG     X1,CRA4     IF NOT END OF TRACK CHAIN
 CRA5     SA2    CRAA        GET SECTOR NUMBER IN LAST TRACK
          LX0    2           POSITION CURRENT TRACK
          BX6    X6*X1       EXTRACT EOI SECTOR OR NEXT TRACK
          SX7    /CIOERR/RAD * RANDOM ADDRESS NOT ON FILE.*
          LX6    -48
          IX6    X6-X2       EOI SECTOR - SECTOR NUMBER IN LAST TRACK
          NG     X6,RPC      IF ADDRESS NOT ON FILE
          SA1    A4+B1       GET SECTORS PER TRACK
          BX7    X2
          EQ     CRA2        EXIT
 
*         PROCESS RETURN RANDOM ADDRESS.
 
 CRA7     SX6    X3          SAVE SECTOR
          BX3    X3-X6       CLEAR SECTOR
          SA6    CRAA
          SX2    B0
          MX6    12
          EQ     CRA9        ENTER LOOP
 
 CRA8     LX0    10
          SB6    B6+B1       INCREMENT TRACK COUNT
          SA1    B3+X0       READ TRT WORD
          LX0    2
          BX2    -X7*X0      EXTRACT BYTE
          LX2    2           BYTE * 4
          LX0    X2,B1       BYTE * 8
          IX2    X0+X2       BYTE * 12
 CRA9     SB2    X2
          LX1    X1,B2       POSITION TRACK BYTE
          BX0    X6*X1       EXTRACT LINK
          BX2    X3-X0       COMPARE TRACK
          ZR     X2,CRA11    IF TRACK FOUND
          NG     X1,CRA8     IF NOT EOI
 
*         IF THIS FALL THROUGH CASE IS TAKEN, THE TRT MUST BE MASHED.
 
 CRA10    SX7    /CIOERR/RAD * RANDOM ADDRESS NOT ON FILE.*
          EQ     RPC         CALL PP CIO
 
 CRA11    SA1    A4+B1       GET SECTORS PER TRACK
          SA2    CRAA        GET SECTOR NUMBER ON THIS TRACK
          SX6    B6
          SX1    X1
          IX7    X1*X6       TRACKS * SECTORS PER TRACK
          IX3    X2+X7       RANDOM ADDRESS
          SB3    -B4
          PL     B4,RRI      IF SET RANDOM ADDRESS IN FET
          JP     B3          RETURN
 
 CRA12    NZ     X3,CRA10    IF RANDOM ADDRESS SPECIFIED
          R=     X3,FSMS     SET RANDOM ADDRESS
          SB3    -B4
          PL     B4,RRI      IF SET RANDOM ADDRESS IN FET
          JP     B3          RETURN
 
 CRAA     CON    0           TEMPORARY
 SFP      SPACE  4,15
**        SFP - SET FST POSITION FOR RANDOM POSITIONING.
*
*         ENTRY  (B4) = RETURN ADDRESS.
*                (X0) = VALUE TO SET FOR CURRENT TRACK.
*                (X3) = RANDOM ADDRESS TO BE SET IN FET+6.
*                (X7) = VALUE TO SET FOR CURRENT SECTOR.
*
*         EXIT   TO *RRI*.
*
*         USES   A - 1, 6.
*                X - 0, 1, 2, 6, 7.
 
 
 SFP      ERX1   X4          GET FST ENTRY
          MX6    -24
          LX1    -12
          BX2    -X6*X1      PREVIOUS TRACK AND SECTOR
          BX6    X6*X1
          BX6    X6+X7       SET CURRENT SECTOR
          LX6    -12
          BX6    X6+X0       SET CURRENT TRACK
          LX6    24
          EWX6   X4
*         EQ     RRI         SET RANDOM INDEX IN FET
 RRI      SPACE  4,10
**        RRI - RETURN RANDOM INDEX TO FET.
*
*         ENTRY  (B4) = RETURN ADDRESS.
*                (X3) = RANDOM INDEX.
*
*         USES   A - 1, 6.
*                X - 1, 2, 6.
 
 
 RRI      SA1    A4-B1       GET RANDOM FILE FLAG
          PL     X1,RB4      IF NOT RANDOM FILE
          BX6    X3          STORE RANDOM INDEX IN FET+6
          SX2    5
          IX2    X5+X2
          LX6    30
          EWX6   X2
          JP     B4          RETURN
 RBI      SPACE  4,10
**        RBI - RELEASE I/O BUFFER INTERLOCK.
*
*         ENTRY  (A0) = RETURN ADDRESS.
*                (X2) = INTERLOCK VALUE (1 FOR READ/SKIP,
*                   4000B FOR WRITE).
*
*         USES   A - 3, 6.
*                B - 4.
*                X - 2, 3, 6.
 
 
 RBI      SA3    LBIA        CHECK IF I/O BUFFER INTERLOCKED
          SB4    A0          SET RETURN ADDRESS
          LX2    48
          ZR     X3,RB4      IF NO BUFFER INTERLOCKED
          SX6    B0+
          SA6    A3+         CLEAR BUFFER INTERLOCK ADDRESS
          SA6    CHRV        CLEAR CONTROL FLAGS
+         SA3    X3+LSLK     **** PERFORM IN ONE WORD ****
          IX6    X3-X2       **** PERFORM IN ONE WORD ****
          SA6    A3          **** PERFORM IN ONE WORD ****
 +        NG     X6,*        IF DATA INTEGRITY ERROR - STOP
          JP     B4          RETURN
 UAC      SPACE  4,15
**        UAC - UPDATE ACCOUNTING AND RELEASE TRACK INTERLOCK.
*
*         ENTRY  (A0) = RETURN ADDRESS.
*                (B6) = RETURN ADDRESS IF CLEAR TRACK INTERLOCK REJECT.
*                (X7) .LT. 0 IF *UADM* TO BE ISSUED BY *PPCX*.
*                (X7) BIT 0 = 0 IF TO RESTART CPU FOR NON-AUTO
*                   RECALL *CIO* CALL.
*
*         EXIT   (X2) = RECALL CPU FLAG IF *UADM* TO BE ISSUED LATER.
*                (X6) = (B4) = NUMBER OF *UADM* PARAMETER WORDS IN
*                   MESSAGE BUFFER IF *UADM* TO BE ISSUED LATER.
*
*         USES   A - 0, 1, 2, 3, 6.
*                B - 4, 6.
*                X - 0, 1, 2, 3, 6, 7.
*
*         MACROS MONITOR.
 
 
*         CHARGE FOR PRUS TRANSFERRED.
*         UPDATE CURRENT RANDOM INDEX IN FET+6 FOR RANDOM FILE.
 
 UAC      SA3    PRUC        GET PRU COUNT
          SX0    X3
          LX0    IMPT
          SA1    UACC        INCREMENT ACCOUNTING
          ZR     X0,UAC1     IF NO DATA TRANSFERRED
          IX6    X1+X0
          SA6    A1
          MX1    1           SET DATA TRANSFERRED FLAG
          LX1    54-59
          SA2    A4          GET MESSAGE BUFFER PARAMETERS
          BX6    X2+X1
          SA6    A4+
          SA1    A4-1        GET RANDOM FILE FLAG
          ZR     X5,UAC1     IF NO FET ADDRESS
          PL     X1,UAC1     IF NOT RANDOM FILE
          SX1    5
          LX0    -IMPT
          IX1    X5+X1
          AX3    30
          IX0    X0-X3
          ERX2   X1          UPDATE RANDOM INDEX IN FET
          LX0    30
          IX6    X2+X0
          EWX6   X1
 
*         CLEAR TRACK INTERLOCK.
 
 UAC1     SA3    A4          CHECK TRACK INTERLOCK
          LX3    59-58
          PL     X3,UAC3     IF TRACK NOT INTERLOCKED
          ERX1   X4          GET EQUIPMENT AND FIRST TRACK
          SX6    CTIS*10000B CLEAR TRACK INTERLOCK
          MX2    24
          BX1    X2*X1
          LX1    -12
          BX6    X6+X1
          SX3    B6+         SAVE RETURN ADDRESS FOR REJECT
          MONITOR  STBM
          AX1    36
          MX6    -59         CLEAR TRACK INTERLOCK FLAG
          ZR     X1,UAC2     IF TRACK INTERLOCK CLEARED
+         SA0    X3          SET REJECT RETURN ADDRESS
          SX7    X7          FORCE *UADM* TO BE ISSUED
          EQ     UAC3        DO NOT CLEAR TRACK INTERLOCK FLAG
 
 UAC2     SA3    A4          GET MESSAGE BUFFER PARAMETERS
          LX6    58-59
          BX6    -X6*X3      CLEAR TRACK INTERLOCK FLAG
          SA6    A4
 
*         BUILD *UADM* PARAMETER WORDS FOR ACCOUNTING CHARGE
*         AND FILE SIZE CHANGES.
 
 UAC3     SA1    UACC        GET ACCOUNTING CHARGE
          MX0    -24
          LX7    49-0
          BX3    -X0*X1
          BX6    X1
          SA1    A5-1        GET AUTO RECALL FLAG
          MX2    1
          LX1    49-41
          LX2    49-59
          BX2    -X7*X2
          BX2    -X1*X2
          LX7    0-49
          SB4    B0+
          ZR     X3,UAC4     IF NO ACCOUNTING UPDATE REQUIRED
          SA6    A5+B1
          SB4    B1
 UAC4     SA3    PCMS
          ZR     X3,UAC5     IF NO PRU INCREMENT/DECREMENT
          SA1    UAMI        GET MASS STORAGE CHANGE PARAMETERS
          SB4    B4+1
          BX6    X1+X3
          SA6    A5+B4
          PL     X3,UAC5     IF TRACKS REQUESTED
          SX6    CICS-CDCS   INCREMENT MASS STORAGE PRU-S
          LX6    48
          IX1    X1+X6
          BX6    -X3+X1
          SA6    A5+B4
 UAC5     SB6    A0          SET RETURN ADDRESS
          SX6    B4          SET *UADM* PARAMETER COUNT
          ZR     B4,RB6      IF *UADM* NOT REQUIRED
          NG     X7,RB6      IF *UADM* TO BE ISSUED LATER
          BX6    X6+X2       SET RECALL CPU FLAGS
          LX6    12
          SX3    1
          BX6    X6+X3       SET NO DROP FLAG
          LX6    24
          MONITOR  UADM,B6
 WEI      SPACE  4,10
**        WEI - WRITE EOI/RELEASE BUFFER INTERLOCKS.
*
*         ENTRY  (A0) = RETURN ADDRESS.
*
*         EXIT   TO *RBI*.
*
*         USES   A - 1, 2, 3, 6.
*                B - 4, 6.
*                X - 0, 1, 2, 3, 6, 7.
*
*         CALLS  CIM, CSA, CSP, IDE, RBI.
*
*         MACROS MONITOR.
 
 
 WEI      SA2    A4+         GET MESSAGE BUFFER PARAMETERS
          SB4    0
          LX2    59-6
          MX3    -12
          PL     X2,WEI8     IF NOT WRITE FUNCTION
 WEI1     SB4    B4+B1
          SA1    A5+B4       GET MULTIPLE WRITE BUFFER ORDINALS
          ZR     X1,WEI3     IF NO MORE WRITE BUFFERS
 WEI2     BX6    -X3*X1
          LX6    CBTLS
          MX0    1
          AX1    12
+         TA2    X6+LSLK,CBT **** PERFORM IN ONE WORD ****
          IX7    X2-X0       **** PERFORM IN ONE WORD ****
          SA7    A2          **** PERFORM IN ONE WORD ****
          NZ     X1,WEI2     IF MORE BUFFERS TO RELEASE
          LE     B4,B1,WEI1  IF MORE INTERLOCK WORDS
 WEI3     SA1    NTKP        GET OLD EOI SECTOR
          SB4    WEI4        SET RETURN ADDRESS FOR *CSA*
          SA2    A4+B1       CHECK IF EOI WRITE REQUIRED
          BX0    X1          SAVE CURRENT SECTOR
          NG     X2,CSA      IF WRITE EOI REQUIRED
          SA2    PCMS        GET MASS STORAGE PRU CHANGE
          ZR     X2,WEI7     IF NO *RTCM* ISSUED
          EQ     WEI5        RESET EOI IN TRT
 
 WEI4     SA2    X3+
          SB6    X6
          MX6    2
          SX7    X7-30B
          ERRNZ  LSLB-40B    CODE DEPENDS ON BUFFER SIZE
          LX6    23-59
          BX2    -X6*X2      CLEAR DATA FLAGS
          NG     X7,WEI4.1   IF NOT IN LAST CONTROL WORD OF BUFFER
          MX6    48
          BX6    X6*X2       CLEAR LINK
 WEI4.1   SX7    10000B      BUILD SHORT PRU MASK
          LX7    B6
          BX6    X2+X7
          SA6    X3          STORE HEADER
          SX6    1
          IX2    X4-X6       STORE FNT ENTRY IN EOI SECTOR
          ERX2   X2
          BX6    X2
          SA6    ERWB        SET UP BUFFER FOR WRITE
          ERX2   X4          STORE FST ENTRY IN EOI SECTOR
          BX6    X2
          SA6    A6+B1
          SB4    A0          SAVE (A0)
          SA2    PDTL        STORE PACKED DATE AND TIME IN EOI SECTOR
          BX7    X2
          SA7    A6+B1
          SA0    A6-B1       FWA TO BEGIN TRANSFER FROM (*ERWB*)
          SX6    A0
          LX6    30
          BX0    X0+X6       30/FWA FROM, 30/FWA I/O BUFFER DATA (TO)
          WE     3
          RJ     HHE         HANG ON HALF-EXIT
          MX7    -6
          BX6    X6-X6
          IX0    X0-X7
          SA6    A0
          WE     1
          RJ     HHE         HANG ON HALF-EXIT
          SA0    B4          RESTORE (A0)
          SB4    WEI5        RETURN ADDRESS FOR *IDE*
          BX0    X1          SAVE CURRENT SECTOR
          SB6    IDE         *CSP* RETURN ADDRESS
          EQ     CSP         CALCULATE SECTOR POSITION
 
 WEI5     ERX2   X4          GET EQUIPMENT AND CURRENT TRACK
          SB7    X6+         RESTORE (B7)
          MX6    12
          MX7    11
          BX6    X6*X2       EQUIPMENT
          LX7    -25
          BX7    X7*X2       CURRENT TRACK
          LX6    -12
          BX6    X6+X7
 
*         SET THE CHECKPOINT BIT FOR THE DEVICE WHEN EXTENDING *LIFT*
*         OR *PMFT* FILES.  CHECKPOINT IS SET FOR *LIFT* TO ENSURE
*         THAT THE DEVICE IS CHECKPOINTED AFTER THE INDIRECT ACCESS
*         PERMANENT FILE CHAIN IS EXTENDED BY *CPUPFM*.  EQUIVALENT
*         LOGIC IS NOT NEEDED IN *1MS* BECAUSE INDIRECT ALLOCATION
*         AND DEVICE CHECKPOINTING IS COMPLETELY MANAGED WITHIN *PFM*
*         FOR NON-BUFFERED DEVICES.
 
          SX2    B1          CHECK FILE TYPE
          IX2    X4-X2
          ERX2   X2
          LX2    -6
          MX7    -6
          BX2    -X7*X2
          SX7    X2-LIFT
          ZR     X7,WEI5.1   IF *LIFT* FILE
          SX7    X2-PMFT
          NZ     X7,WEI6     IF NOT *PMFT* FILE
 WEI5.1   MX7    1           SET DEVICE CHECKPOINT
          LX7    -12
          BX6    X6+X7
 WEI6     LX0    12          EOI SECTOR
          BX6    X6+X0
          MONITOR  DTKM      DROP TRACKS AND SET EOI
          SA2    PCMS        UPDATE MASS STORAGE PRU CHANGE
          IX6    X2-X1
          SA6    A2
 WEI7     MX2    1           SET INTERLOCK VALUE
          LX2    12
          EQ     RBI         RELEASE BUFFER INTERLOCK
 
 WEI8     SA3    LBIA        CHECK I/O BUFFER INTERLOCKED
          SB4    A0+
          ZR     X3,RB4      IF NO BUFFER INTERLOCKED
          SX1    B1          GET I/O BUFFER LINK
          IX1    X4+X1
          ERX1   X1
          MX6    -12
          BX6    -X6*X1
          SX2    B1          SET INTERLOCK VALUE
          ZR     X6,RBI      IF NO LINK IN FNT ENTRY
          SB6    WEI9        SET RETURN ADDRESS FOR *CSP*
          EQ     CSP         CALCULATE SECTOR POSITION
 
 WEI9     SA1    CHRV        ALLOW ACCESS TO OFF/SUSPECT DEVICE
          SX2    EPNS
          BX6    X2+X1
          SA6    A1
          SX2    BMRB*100B   RELEASE READ BUFFER
          NG     X7,CIM      IF NEXT SECTOR NOT IN SAME BUFFER
          SX7    X7-LSLB
          PL     X7,CIM      IF NEXT SECTOR NOT IN SAME BUFFER
          SX2    B1+         SET INTERLOCK VALUE
          EQ     RBI         RELEASE BUFFER INTERLOCK
 
          ENDBLK
          BLOCK  IHPFMD,(NON-819 INTERRUPT HANDLER.)
 BIO      SPACE  4,15
**        BIO - PROCESS *BIOM* MONITOR FUNCTION.
*
*         ENTRY  (A5) = OUTPUT REGISTER ADDRESS.
*                (X5) = OUTPUT REGISTER.
*
*         USES   X - ALL.
*                A - ALL.
*                B - 3, 4, 5.
*
*         CALLS  /BUFIO/DLB, /BUFIO/SBR,
*                /MONITOR/HNG, /MONITOR/PPRX.
 
 
 BIO      LX5    -24         POSITION *PUT* ORDINAL
          MX0    -12
          BX6    -X0*X5
          AX1    36          EXTRACT SUB-FUNCTION
          ZR     X6,/MONITOR/HNG  IF INVALID *PUT* ORDINAL
          TX2    X6-1,-NRUN
          PL     X2,/MONITOR/HNG  IF INVALID *PUT* ORDINAL
          LX6    PUTLS
          SX3    A5          OUTPUT REGISTER ADDRESS
          TA4    X6+PILL,PUT
          BX7    -X0*X4      CHECK UNIT INTERLOCK
          IX2    X7-X3
          ZR     X1,TBIO     IF *SUIS* REQUEST
          ERRNZ  SUIS        CODE DEPENDS ON VALUE
          NZ     X2,/MONITOR/HNG  IF NOT ASSIGNED THIS PP
          SX6    A4-PILL+UNCT
          SB4    X1-TBIOL
          SA6    PUTA        SAVE *PUT* ADDRESS
          LX5    -48
          MX2    -11
          JP     TBIO+TBIOL+B4  EXIT TO PROCESSOR
 
*         ENTER PROCESSOR WITH -
*
*         (A4) = ADDRESS OF *PILL* WORD.
*         (A6) = ADDRESS OF *PUTA*.
*         (X0) = 48 BIT MASK.
*         (X2) = 49 BIT MASK.
*         (X4) = *PILL* WORD OF *PUT* ENTRY.
*         (X5) = PP OUTPUT REGISTER SHIFTED LEFT -12.
*         (X6) = *PUT* ADDRESS OF *UNCT* WORD.
*         (X7) = BYTE 4 OF *PILL* WORD.
 
 TBIO     BSS    0
 
          BSS    0           FORCE UPPER
 SUIS     EQU    *-TBIO
 SUIS     EQU    //SUIS      ENSURE SUBFUNCTION CORRECT
          LX7    36
          MX0    1
          EQ     BIO10       SET UNIT INTERLOCK
 
          BSS    0           FORCE UPPER
 DCBS     EQU    *-TBIO
 DCBS     EQU    //DCBS      ENSURE SUBFUNCTION CORRECT
          SX7    BIO24
          TEQ    (/PROBE/IOS,PROBE,/IHPFMD/BIO20)  UPDATE *PROBE* TABLE
 
          BSS    0           FORCE UPPER
 SETS     EQU    *-TBIO
 SETS     EQU    //SETS      ENSURE SUBFUNCTION CORRECT
          SA3    X6
          LX3    -12
          EQ     BIO30       SET ERROR STATUS IN *CBT*
 
          BSS    0           FORCE UPPER
 IDSS     EQU    *-TBIO
 IDSS     EQU    //IDSS      ENSURE SUBFUNCTION CORRECT
          SX7    BIO40
          EQ     BIO20       INHIBIT DATA STREAMING
 
          BSS    0           FORCE UPPER
 CETS     EQU    *-TBIO
 CETS     EQU    //CETS      ENSURE SUBFUNCTION CORRECT
          SA1    X6
          BX2    -X0*X1
          EQ     BIO60       CLEAR ERROR STATUS FROM I/O QUEUE
 
          BSS    0           FORCE UPPER
 TBIOL    EQU    *-TBIO
 
*         SET UNIT INTERLOCK.
 
 BIO10    NZ     X7,/MONITOR/PPR1  IF *PUT* ENTRY INTERLOCKED
          BX6    X4+X3
          SA6    A4          SET INTERLOCKING PPOR ADDRESS
          SA2    A4-PILL+UNCT
          BX6    X0+X2       SET UNIT INTERLOCK FLAG
          SA6    A2
          EQ     /MONITOR/PPR1  EXIT
 
*         DELINK CONTROL BUFFER(S) / INHIBIT DATA STREAMING.
 
 BIO20    SA7    PADD        SAVE PROCESSOR ADDRESS
          BX6    -X2*X5
          ERRNZ  CBCT-PUTA-2 CODE DEPENDS ON VALUES
          SA6    A7+B1       BUFFER COUNT
 BIO21    SA4    CBCT        DECREMENT BUFFER COUNT
          SX6    X4-1
          ZR     X4,BIO27    IF REQUEST COMPLETE
          SA1    PUTA
          SA2    X1          FETCH *UNCT* WORD FROM *PUT*
          MX0    -12
          BX5    X2          PRESERVE (X2) FOR *DLB*
          SA6    A4
          SA3    A4-B1       RETRIEVE PROCESSOR ADDRESS
          AX5    12
          SB4    X3
          BX7    -X0*X5      EXTRACT CURRENT CONTROL BUFFER ORDINAL
          SX6    B1
          LX7    CBTLS
          ZR     X7,/MONITOR/HNG  IF I/O QUEUE EMPTY
          TA4    X7+IOLK,CBT
          JP     B4          EXIT TO PROCESSOR
 
*         DELINK CONTROL BUFFER(S).
 
 BIO24    SA3    STAT
          NZ     X3,BIO25    IF CALLED VIA *SETS* SUBFUNCTION
          SA3    A4+B1       READ *HSLK* WORD
          ERRNZ  HSLK-IOLK-1  CODE DEPENDS ON VALUE
          MX0    -48
          BX7    -X0*X3      CLEAR ERROR DATA
          SA7    A3
 BIO25    SA3    A4-IOLK
          LX4    -57         EXTRACT WRITE FLAG
          BX7    X6*X4       WRITE FLAG
          ERRNZ  HSCT-1      CODE DEPENDS ON VALUE
          SA4    X1+B1
          IX7    X1+X7       ACCUMULATOR ADDRESS + WRITE FLAG
          ERRNZ  RDST+1-WTST INDICES MUST BE CONSECUTIVE
          SA1    X7+RDST     ACCUMULATOR WORD
          AX4    54          PHYSICAL SECTORS PER BUFFER
          SB3    BIO26       *DLB* RETURN ADDRESS
          IX6    X1+X4       INCREMENT ACCUMULATOR
          LX6    59-35
          NG     X6,/BUFIO/DLB  IF ACCUMULATOR OVERFLOW
          LX6    35-59
          SA6    A1          UPDATE ACCUMULATOR
          EQ     /BUFIO/DLB  DELETE BUFFER
 
 BIO26    SB3    BIO21       *SBR* RETURN ADDRESS
          EQ     /BUFIO/SBR  SET BUFFER RECALL
 
 BIO27    SA5    A5          CHECK INTERLOCK FLAG
          LX5    59-23
          PL     X5,BIO29    IF NOT CLEARING UNIT INTERLOCK
 BIO28    SA4    PUTA
          MX1    -59         SET MASKS
          MX0    -12
          SA3    X4-UNCT+PILL  FETCH PP INTERLOCK WORD
          BX6    X0*X3
          SA6    A3          CLEAR PP INTERLOCK
          SA4    X4+
          BX6    -X1*X4      CLEAR UNIT BUSY
          SA6    A4
 BIO29    BX7    X7-X7       CLEAR OUTPUT REGISTER IMAGE
          SA2    STAT        SET REPLY STATUS
          SA7    A2
          BX7    X2
          SA7    A5
          EQ     /MONITOR/PPRX  RETURN
 
*         PROCESS I/O ERROR.
 
 BIO30    BX2    -X0*X3      EXTRACT CURRENT *CBT* ORDINAL
          LX2    CBTLS       *CBT* INDEX
          TA4    X2+HSLK,CBT
          MX7    -48
          LX5    12
          BX7    -X7*X4      CLEAR *HSLK* ERROR PROCESSING DATA
          LX3    -24
          BX3    -X0*X3      EST ORDINAL
          CX1    X3,EST      CONVERT EST ORDINAL TO OFFSET
          TA1    X1+EQDE,EST
          BX6    -X0*X5      EXTRACT ERROR CODE
          MX2    2
          SA3    A5-B1       READ INPUT REGISTER
          BX2    X2*X4
          LX1    24+3        POSITION SECONDARY CHANNEL BYTE
          SB3    X6-DDFE
          BX3    -X0*X3
          NG     X2,BIO35    IF I/O ERROR FLAG ALREADY SET
          LX4    1
          LX6    48
          NG     X4,BIO32    IF DEVICE VERIFICATION CALL
          LX0    48+3
          MX4    3           FORM CHANNEL MASK
          BX0    X4+X0
          BX5    -X0*X1      CHECK SECONDARY CHANNEL ACCESSIBLE
          SB5    X5-4
          LX1    -12
          BX4    -X0*X1      PRIMARY CHANNEL DATA
          SB4    X4-4
          AX4    48+3        PRIMARY CHANNEL
          BX1    X4-X3
          AX5    48+3        SECONDARY CHANNEL
          ZR     X1,BIO31    IF CALLER ON PRIMARY CHANNEL
          NZ     B4,BIO32    IF PRIMARY CHANNEL UNAVAILABLE
          SX3    X4          SELECT PRIMARY CHANNEL
          EQ     BIO32       CONTINUE
 
 BIO31    NZ     B5,BIO32    IF SECONDARY CHANNEL UNAVAILABLE
          SX3    X5+         SELECT SECONDARY CHANNEL
 BIO32    LX3    54          CHANNEL
          MX0    1           I/O ERROR FLAG
          BX0    X2+X0       I/O ERROR + FORCED CHANNEL SELECTION FLAGS
          LX4    X2,B1       POSITION FORCED CHANNEL SELECTION
          SA1    A4-HSLK+PAD4
          MX5    -54
          BX6    X6+X0       COMBINE FLAGS AND ERROR CODE
          BX1    -X5*X1      CLEAR CHANNEL FIELD
          BX6    X7+X6       MERGE ERROR DATA INTO *HSLK*
          SA6    A4+
          BX7    X1+X3       MERGE CHANNEL INTO *PAD4*
          SA7    A1+
          NG     X4,BIO33    IF DEVICE VERIFICATION CALL
          NZ     B3,BIO28    IF ERROR NOT DIAGNOSTIC FAILURE
 BIO33    SA5    A5          REREAD OUTPUT REGISTER
          SX7    B1
          LX7    23-0        FORCE CLEARING OF *PUT* INTERLOCK
          BX6    X5+X7
          SA6    A5
          MX2    -11
          LX7    36-23       SET REPLY STATUS
          SX5    B1
          SA7    STAT
          JP     TBIO+DCBS   DELINK CURRENT CONTROL BUFFER
 
 BIO35    SA4    A4-HSLK+IOLK
          LX6    48          POSITION ERROR CODE
          BX6    X2+X6       ERROR CODE + FORCED CHANNEL SELECTION
          LX3    54          POSITION CHANNEL
          SA1    A4-IOLK+PAD4
          BX6    X6+X7       MERGE ERROR DATA INTO *HSLK*
          MX5    -54
          BX1    -X5*X1      CLEAR CHANNEL FIELD
          BX7    X1+X3       MERGE CHANNEL INTO *PAD4*
          LX4    59-57
          SA6    A4-IOLK+HSLK  UPDATE *HSLK*
          SA7    A1+         UPDATE *PAD4*
          PL     X4,BIO33    IF READ OPERATION
          SB3    B3+DDFE-PARE
          ZR     B3,BIO33    IF MEDIA ERROR
          BX3    X6
          LX3    59-58
          NG     X3,BIO33    IF DEVICE VERIFICATION REQUEST
          SA3    PUTA
          LX4    57-59-24    POSITION FORWARD LINK FOR I/O QUEUE
          SA1    X3+         FETCH *UNCT* WORD FROM *PUT*
          BX2    -X0*X4
          LX0    12
          SB6    BIO37
          BX3    -X0*X1      CURRENT CBT ORDINAL
          LX3    CBTLS-12
          TA3    X3+LSLK,CBT
          MX6    -6
          MX5    -24
          LX6    18
          BX5    -X5*X3      RECALL DATA
          BX6    -X6*X3      RECALL CONTROL POINT NUMBER
          ZR     X5,BIO36    IF RECALL NOT SET
          ZR     X6,BIO33    IF PP IN RECALL
 BIO36    BX6    X0*X1       CLEAR CURRENT BUFFER ORDINAL
          EQ     /BUFIO/SCB  SELECT CURRENT BUFFER
 
 BIO37    SA6    A1+
          SX7    B1          SET REPLY STATUS
          LX7    36-0
          SA7    STAT
          EQ     BIO28       CLEAR *PUT* INTERLOCK
 
*         INHIBIT DATA STREAMING.
 
 BIO40    LX6    53-0
          BX6    X6+X4       SET INHIBIT FLAG
          SA6    A4+
          EQ     BIO21       PROCESS NEXT REQUEST
 
*         CLEAR ERROR STATUS FROM UNIT I/O QUEUE.
 
 BIO60    ZR     X2,BIO28    IF QUEUE EMPTY
          MX5    -48
          LX2    CBTLS
 BIO61    TA4    X2+HSLK,CBT  CLEAR ERROR STATUS
          BX6    -X5*X4
          SA6    A4          UPDATE *CBT* ENTRY
          SA3    A4-B1
          ERRNZ  IOLK+1-HSLK  CODE DEPENDS ON VALUE
          LX3    -24
          BX2    -X0*X3      EXTRACT FORWARD LINK
          LX2    CBTLS
          NZ     X2,BIO61    IF NOT END OF QUEUE
          BX3    -X0*X1
          LX1    -12         POSITION *UNCT* WORD
          BX4    -X0*X1
          NZ     X4,BIO28    IF CURRENT *CB* PRESENT
          BX6    X1+X3
          LX6    12          SET CURRENT *CB* = FIRST
          SA6    A1
          EQ     BIO28       CLEAR *PUT* INTERLOCK
 
 
 PUTA     BSS    3           *PUT* ADDRESS OF *UNCT* WORD
 PADD     EQU    PUTA+1      PROGRAM TRANSFER ADDRESS
 CBCT     EQU    PADD+1      CONTROL BUFFER COUNT
 STAT     CON    0           REPLY STATUS
 RPP      SPACE  4,15
**        RPP - RECALL PSEUDO-PP.
*
*         ENTRY  (A3) = CONTROL BUFFER ADDRESS.
*                (A5) = OUTPUT REGISTER ADDRESS.
*
*         EXIT   (X5) = OUTPUT REGISTER.
*                TO *BIO*.
*
*         USES   X - 1, 5, 7.
*                A - 1, 5, 7.
*                B - 7.
*
*         CALLS  /BUFIO/PRQ.
 
 
 RPP      TX1    A3,-CBT     COMPUTE CONTROL BUFFER ORDINAL
          SX7    A5          SAVE PP OR ADDRESS
          AX1    CBTLS
          SA7    /BUFIO/IPPA
          EQ     /BUFIO/PRQ  PROCESS REQUEST QUEUE
 
 RPP1     SA5    /BUFIO/IPPA  RESTORE (A5)
          SX7    -B1         RESET *IPPA*
          SA5    X5
          SA7    /BUFIO/IPPA
          EQ     BIO21       PROCESS NEXT REQUEST
 
          ENDBLK
          BLOCK  IH819,(INTERRUPT HANDLER - 819/CYBER 176.)
          SPACE  4,10
**        DATA.
 
 
 NRQT     BSS    MMXC/2+1    NEXT REQUEST(S)
 RTCI     BSS    1           INTERRUPT START TIME
 PPE      SPACE  4,15
**        PPE - EXTENSION FOR BUFFER MANAGER RECALL.
*
*         ENTRY  (A1) = ADDRESS OF *PSD*.
*                (X1) = CONTENTS OF *PSD*.
*
*         EXIT   TO */MONITOR/MTRX*  IF NO MORE REQUESTS TO PROCESS.
*                TO *PRQ* IF TO PROCESS PSEUDO PP REQUEST.
*
*         CALLS  /BUFIO/PRQ.
 
 
 PPE      MX2    -57         CLEAR STEP CONDITION
          BX6    -X2*X1
          SX7    B7
          LX6    39-59
          SA7    /BUFIO/IPPA SAVE (B7)
          SA6    A1+
 PPE1     SA2    BMRI
          ZR     X2,PPE2     IF NO REQUESTS PRESENT
          SX7    X2-1
          SA1    TBMR+X7     GET REQUEST
          SA7    A2          UPDATE REQUEST INDEX
          EQ     /BUFIO/PRQ  PROCESS REQUEST QUEUE
 
 PPE2     SA1    /BUFIO/IPPA RESTORE (B7)
          SX7    -B1
          SB7    X1
          SA7    A1          RESET SAVE WORD
          EQ     /MONITOR/MTRX  EXIT
 XJ2      SPACE  4,10
**        XJ2 -  EXTENSION TO CHECK STEP CONDITION ON RA+1 REQUEST
*
*         ENTRY  (B2) = EXCHANGE PACKAGE ADDRESS
*
*         EXIT   TO */BUFIO/PPE* IF STEP MODE SET
*                TO */MONITOR/XJ2*  IF STEP MODE NOT SET
 
 
 XJ2      SA1    B2+3        GET *PSD*
          LX1    59-39
          PL     X1,/MONITOR/MTR  IF NOT STEP MODE
          EQ     PPE         PROCESS BUFFER MANAGER RECALL
 TBMR     SPACE  4,10
**        BUFFER MANAGER RECALL REQUESTS ARE PASSED FROM THE 819
*         INTERRUPT HANDLER IN THE FOLLOWING TABLE.  THERE IS A
*         POINTER (INDEX) TO THE NEXT AVAILABLE ENTRY IN *BMRI*,
*         WHICH IS ADJUSTED EACH TIME THE TABLE IS ACCESSED.
 
 
 TBMR     BSS    BMRL        BUFFER MANAGER RECALL REQUEST TABLE
 
 BMRI     CON    0           REQUEST INDEX
 RIO      SPACE  4,10
**        RIO - RESTART 819 I/O.
*
*         EXIT   TO /BUFIO/IOCX.
*
*         USES   X - 1, 2, 5, 6, 7.
*                A - 1, 2, 5, 6, 7.
*                B - 6, 7.
*
*         CALLS  IOA.
 
 
 RIO      SA1    RIOA        PRESET *IOA* FOR RECOVERY PROCESS
          SA2    IOA3
          BX6    X1
          BX7    X2
          SA6    A2
          SA7    A1
          SX7    B0+         PRESET *CCT* INDEX
          SA7    RIOB
 RIO1     LX7    CCTLS
          SB7    B0          INITIALIZE UNIT NUMBER
          TA5    X7+CCNT,CCT SET *CCT* ENTRY ADDRESS
          SB6    7           SET UNIT COUNT
          BX7    X5
          EQ     IOA1        ENTER *IOA* TO PROCESS CHANNEL
 
 RIO2     SA1    RIOB        GET *CCT* INDEX
          SX7    X1+B1
          SA7    A1
          SX1    X7-NCCT
          NG     X1,RIO1     IF NOT END OF *CCT*
          SA1    RIOA        RESTORE *IOA*
          BX6    X1
          SA6    IOA3
          EQ     /BUFIO/IOCX RETURN
 
 
 RIOA     EQ     RIO2        *IOA* RETURN ADDRESS
 RIOB     CON    0           *CCT* INDEX
 CLU      SPACE  4,10
**        CLU - CLEAR UNIT FLAGS.
*
*         ENTRY  (A2) = *PUT* ENTRY ADDRESS.
*                (B2) = CHANNEL NUMBER.
*
*         USES   X - ALL.
*                A - 2, 4, 5, 6, 7.
*                B - 3, 5.
*
*         CALLS  INR, SAA.
 
 
 CLU      SX6    B2          CHANNEL NUMBER
          MX0    -59
          LX6    CCTLS/2
          MX7    6
          TA4    X6,CCT      READ CHANNEL CONTROL TABLE
          SA2    A2          GET *PUT* ENTRY
          LX7    -6
          SA5    A4+B1       READ CHANNEL CONTROL TABLE
          ERRNZ  CCNT-CREQ-1 INDEXES MUST BE CONSECUTIVE
          BX3    X7*X2       UNIT NUMBER
          BX6    -X0*X4      CLEAR CHANNEL BUSY
          LX3    12
          SX1    B1
          SB5    X3-60D
          IX6    X6-X1       DECREMENT ACTIVE COUNT
          AX0    B5
          MX1    -12
          BX7    -X0*X5      CLEAR UNIT REQUESTED FLAG
          LX1    12
          SA7    A5
          BX0    -X1*X2      CURRENT REQUEST
          SB3    CLU2        *INR* RETURN ADDRESS
          LX1    12
          BX3    -X1*X4      RETRY REQUEST
          BX6    X1*X6       CLEAR RETRY REQUEST
          LX3    -24+PUTLS
          SA6    A4
          LX1    -12
          MX6    18
          LX6    -6
          BX6    X6*X2       CLEAR UNIT REQUEST QUEUE
          NZ     X0,CLU1     IF ANOTHER REQUEST PRESENT
          SA6    A2
          ZR     X3,CLU2     IF NO RETRY REQUEST
          TA4    X3,PUT      GET *PUT* ENTRY
          NG     X4,CLU2     IF UNIT BUSY
          MX5    1
          BX0    -X1*X4      CURRENT REQUEST
          BX6    X4+X5       SET UNIT BUSY
          ZR     X0,CLU2     IF NO CURRENT REQUEST
          SA6    A4
 CLU1     LX0    -12
          EQ     INR         INITIATE REQUEST
 
 CLU2     SB3    IOLX        *SAA* RETURN ADDRESS
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 DCS      SPACE  4,20
**        DCS - DECODE STATUS.
*
*         XP     SLAVE INPUT.
*
*         ENTRY  (A0) = CM BUFFER ADDRESS.
*                (A1) = PARTNER XP ADDRESS.
*                (A2) = *PUT* ENTRY ADDRESS.
*                (A3) = CONTROL BUFFER ADDRESS.
*                (B2) = CHANNEL NUMBER.
*                (B4) = PARTNER CHANNEL NUMBER.
*
*         EXIT   TO *CLU*.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 4, 6, 7.
*
*         CALLS  /MONITOR/APQ, /BUFIO/DLB, /BUFIO/SBR.
 
 
 DCS      RO     B2          RELEASE FLPP DRIVER
          SA4    A0          READ FIRST WORD OF CM BUFFER
          SA5    A0+B1       SECOND WORD
          RI     B2          RESET I/O BUFFER POINTERS
          RI     B4
          LX4    59-57
          SB6    DCSA        *819 PRTY*
          NG     X4,CLU      IF COMPLETION STATUS
          SA2    A2          READ *PUT* ENTRY
          ERRNZ  UNCT        INDEX MUST BE ZERO
          MX0    -3
          LX0    54
          SX4    B0+
          BX7    -X0*X2      READ RECOVERY INDEX
          NZ     X7,DCS4     IF READ RECOVERY TO PROCESS
          MX1    -48
          LX5    59-5
          SX6    NRDE
          SB3    DCS2        *DLB* RETURN ADDRESS
          NG     X5,DCS1     IF *NOT READY* CONDITION
          SX6    DSTE        SET *DEVICE STATUS* ERROR CODE
 DCS1     LX6    48          POSITION ERROR CODE
          BX2    X0*X2       CLEAR READ RECOVERY INDEX
          BX3    X5
          SA4    A0
          SA5    A3+HSLK
          LX4    59-42
          BX7    -X1*X5
          MX1    1
          BX7    X1+X7       SET ERROR FLAG
          BX7    X6+X7       MERGE  ERROR CODE INTO *HSLK*
          SA7    A5
          SA5    A5-HSLK+IOLK
          PL     X4,/BUFIO/DLB  IF BUFFER DOES NOT CONTAIN WRITE DATA
          NG     X3,DCS3     IF DISK NOT READY
          PL     X5,DCS2     IF BUFFER DELETED BY *WRT*
          EQ     /BUFIO/DLB  DELETE BUFFER
 
 DCS2     SB3    DCS3        *SRC* RETURN ADDRESS
          SB7    B0+         EXCHANGE PACKAGE INDEX
          EQ     /BUFIO/SBR  SET BUFFER RECALL
 
 DCS3     SA4    A0+B1       READ CM BUFFER
          SB6    DCSB        *819 ABT*
          LX4    59-5
          PL     X4,DCS4     IF NOT DISK NOT READY
          SB6    DCSC        *819 NRDY*
 DCS4     SA5    B6          SET MESSAGE IN SYSTEM CONTROL POINT
          SX1    A1          SAVE (A1), (A2), (B4)
          SX2    A2
          LX1    18
          BX6    X5
          SA5    A2          GET *PUT* ENTRY
          MX7    -6          GET EST ORDINAL (LOWER 6 BITS)
          LX5    -36
          BX5    -X7*X5
          MX7    -3
          BX7    -X7*X5
          AX5    3
          LX5    6
          BX7    X5+X7
          LX7    12
          IX6    X6+X7
          BX7    X1+X2
          TA6    MS2W,SCA
          NG     X4,CLU      IF DISK NOT READY
          SA5    A0+         GET BLOCK WORD COUNT
          SA7    DCSD
          SX6    B4
          SA4    A2          READ *PUT* ENTRY
          ERRNZ  UNCT        INDEX MUST BE ZERO
          SA6    A7+B1
          MX7    -11
          SX3    5
          BX2    -X7*X5      WORD COUNT
          SX1    B2          MASTER FLPP CHANNEL NUMBER
          SX2    X2+9+4      BYTE COUNT OF STATUS PACKET
          LX1    21-1
          IX3    X2/X3       WORD COUNT OF STATUS PACKET
          MX7    -9
          LX4    -36
          SA2    DCSE        18/*1MD*,42/0
          BX7    -X7*X4      EST ORDINAL
          LX7    12
          BX7    X7+X1
          TA4    EMB         GET *EMB* HEADER 1 (FLAGS, *IN*)
          BX7    X7+X5
          SA1    A4+B1       GET *EMB* HEADER 2 (*OUT*, *LIMIT*)
          LX4    -12         POSITION *IN*
          SA7    A0
          MX0    -12
          SX3    X3+B1       ADD ONE FOR HEADER
          BX6    -X0*X1      *LIMIT*
          LX1    -12
          BX5    -X0*X4      *IN*
          BX1    -X0*X1      *OUT*
          SB3    DCS6        *APQ* RETURN ADDRESS IF *EMB* FULL
 
*         THE FOLLOWING CODE EMULATES THE ERROR MESSAGE BUFFER
*         HANDLING FOUND AND DOCUMENTED IN COMMON DECK *COMPIMB*.
 
*         (X0) = -7777
*         (X1) = *OUT*
*         (X2) = *1MD* INPUT REGISTER/*EMB* TERMINATOR
*         (X3) = MESSAGE LENGTH INCLUDING HEADER (*ML*).
*         (X4) = *EMB* HEADER 1 (SHIFTED -12)
*         (X5) = *IN*
*         (X6) = *LIMIT*
 
 DCS4.1   IX7    X5-X1       *IN* - *OUT*
          NG     X7,DCS4.2   IF *IN* .LT. *OUT*
          IX7    X5+X3       *IN* + *ML*
          IX7    X7-X6       *IN* + *ML* - *LIMIT*
          NG     X7,DCS4.3   IF MESSAGE FITS BETWEEN *IN* AND *LIMIT*
          BX7    X2          SET TERMINATOR IN *EMB*
          ZR     X1,DCS5     IF *OUT* .EQ. *FIRST* - DO NOT RESET *IN*
          TA7    X5+2,EMB
          MX5    0           RESET *IN*
          EQ     DCS4.1      RECHECK MESSAGE FIT
 
 DCS4.2   IX7    X7+X3       *IN* + *ML* - *OUT*
          PL     X7,DCS5     IF MESSAGE WILL NOT FIT - CALL *1MD*
 DCS4.3   SB4    X5+B1
          IX7    X5+X3       UPDATE *IN*
          SB4    B4+X3
          BX5    X0*X4       REMOVE OLD *IN*
          SB6    X3-1
          IX7    X5+X7       MERGE IN UPDATED *IN*
          SB3    DCS7        *APQ* RETURN ADDRESS
          LX7    12
          SA7    A4+         UPDATE *EMB* HEADER 1
 DCS4.9   SA5    A0+B6       MOVE ERROR DATA TO BUFFER
          SB6    B6-B1
          BX7    X5
          SA7    A4+B4
          SB4    B4-B1
          PL     B6,DCS4.9   IF NOT END OF MOVE
          LX3    12          SET WORD COUNT IN HEADER
          SX7    MLDY+4000B  SET 819 DRIVER MAINTENANCE LOG CODE
          BX7    X7+X3
          SA7    A4+B4       STORE HEADER IN BUFFER
 DCS5     LX4    59-1-59+11
          NG     X4,/MONITOR/RB3  IF *1MD* ALREADY ACTIVE
          BX6    X2
          TB7    SCA         SYSTEM CONTROL POINT ADDRESS
          SB6    DCS5.1      *CAL* RETURN ADDRESS - NO LIMIT
          EQ     /MONITOR/CAL  CHECK ACTIVITY LIMIT
 
 DCS5.1   SA4    A4          GET BUFFER CONTROL WORD
          SX2    B1+B1       SET *1MD* CALLED FLAG
          BX7    X2+X4
          SA7    A4
          SB4    B0          SET LIBRARY SEARCHED NEEDED
          EQ     /MONITOR/APQ  ASSIGN *1MD*
 
 DCS6     TA5    EMB         SET DATA LOST FLAG
          SX6    B1+
          LX6    36
          BX6    X5+X6
          SA6    A5+
 DCS7     SA4    DCSD        RESTORE (A1), (A2), (B4)
          SA5    A4+B1
          SA2    X4
          SB4    X5
          AX4    18
          SA1    X4+
          EQ     CLU         CLEAR UNIT FLAGS
 
 
 DCSA     DATA   C*819PTY00*
 DCSB     DATA   C*819ABT00*
 DCSC     DATA   C*819NRY00*
 DCSD     BSS    2           REGISTER SAVE AREA
 DCSE     VFD    18/3R1MD,42/0  *1MD* INPUT REGISTER/*EMB* TERMINATOR
 FNR      SPACE  4,15
**        FNR - FIND NEXT REQUEST.
*
*         ENTRY  (B3) = RETURN ADDRESS.
*                (B4) = CHANNEL NUMBER.
*                (B7) = 0  IF READ,  1  IF WRITE.
*                (A3) = CONTROL BUFFER ADDRESS.
*
*         EXIT   (X7) = NEGATIVE IF NO MORE REQUESTS ON THIS CYLINDER.
*                (X7) = 0  IF CONTINUOUS REQUEST (NO POSITIONING).
*                (X7) = TRACK AND SECTOR OF NEXT REQUEST.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 3, 4, 5, 6, 7.
 
 
 FNR      SA4    A3+IOLK     READ CONTROL BUFFER
          MX6    -12
          SX1    B4          CHANNEL
          LX4    -24
          BX4    -X6*X4      LINK TO NEXT REQUEST
          ZR     X4,FNR2     IF END OF QUEUE
          LX4    CBTLS
          SX2    B1
          TA4    X4+IOLK,CBT READ NEXT CONTROL BUFFER
          SX7    B7          READ/WRITE FLAG
          LX2    57
          LX7    57
          BX5    X2*X4       EXTRACT WRITE DATA FLAG
          AX1    CCTLS/2
          BX7    X7-X5
          NZ     X7,FNR2     IF NOT MATCHING MODES (READ/WRITE)
          SA5    A4+PAD1-IOLK  READ PHYSICAL ADDRESS
          SA3    A3          READ CURRENT PHYSICAL ADDRESS
          ERRNZ  PAD1        INDEX MUST BE ZERO
          SX7    A5
          SA7    NRQT-1+X1   SET NEXT REQUEST
          LX5    24
          LX3    24
          BX7    X5
          BX2    X3-X5
          AX7    48
          AX3    48
          BX6    -X6*X2
          IX3    X7-X3
          NZ     X6,FNR2     IF NOT SAME CYLINDER
          BX7    X7-X7       SET CONTINUOUS REQUEST FOUND
          SX3    X3-PSLB
          LX5    6
          ZR     X3,FNR1     IF CONTINUOUS SECTORS
          MX1    -6
          SX7    B1+B1       SET *SWITCH* FUNCTION
          BX1    -X1*X5      TRACK
          LX7    4
          LX5    6
          BX7    X1+X7
          MX1    -6
          LX7    5
          BX1    -X1*X5      SECTOR
          BX7    X7+X1
 FNR1     LX7    48
          MX3    1           SET I/O LINKUP
          LX3    56-59
          BX6    X4+X3
          SA6    A4
          JP     B3          RETURN
 
 FNR2     SX5    B4+         SET *STOP* FOR NEXT REQUEST
          MX7    1
          AX5    CCTLS/2
          SA7    NRQT-1+X5
          JP     B3          RETURN
 INR      SPACE  4,10
**        INR - INITIATE REQUEST.
*
*         ENTRY  (B3) = RETURN ADDRESS.
*                (X0) = CONTROL BUFFER ORDINAL.
*
*         USES   X - ALL.
*                A - 2, 3, 4, 5, 6, 7.
*                B - 5, 7.
 
 
 INR      LX0    CBTLS
          MX7    -12
          TA5    X0+HSLK,CBT
          BX2    -X7*X5      *PUT* ORDINAL
          SA3    A5+FSTC-HSLK
          LX2    PUTLS
          LX3    12
          TA2    X2+UNCT,PUT
          BX3    -X7*X3      EST ORDINAL
          LX2    12
          CX5    X3,EST      CONVERT EST ORDINAL TO OFFSET
          MX3    -6
          BX3    -X3*X2
          MX1    12
          SB7    X3          UNIT NUMBER
          LX1    3
          MX4    3           FORM CHANNEL MASK
          LX2    -6
          BX1    X1-X4
          TA5    X5+EQDE,EST  READ EST ENTRY
          LX5    24+3
          BX6    X1*X5       EXTRACT ALTERNATE CHANNEL
          SB5    X6-4
          AX6    48+3-CCTLS/2  CHANNEL CONTROL TABLE INDEX
          LX5    -12
          BX5    X1*X5       EXTRACT PRIMARY CHANNEL
          SX1    X5-4
          AX5    48+3-CCTLS/2  CHANNEL CONTROL TABLE INDEX
          TA3    X5+CREQ,CCT
          NZ     B5,INR2     IF ALTERNATE ACCESS UNAVAILABLE
          TA4    X5+CREQ,CCT
          SB5    X1          SAVE PRIMARY CHANNEL STATUS
          BX1    -X7*X3
          NZ     B5,INR1     IF PRIMARY ACCESS UNAVAILABLE
          BX7    -X7*X4      ACTIVE REQUESTS - SECOND CHANNEL
          IX7    X1-X7
          NG     X7,INR2     IF FIRST CHANNEL HAS FEWEST REQUESTS
 INR1     SA3    A4+         USE SECOND CHANNEL
 INR2     NG     X3,INR3     IF CHANNEL BUSY
          TX4    A3-CREQ,-CCT  COMPUTE CHANNEL NUMBER
          MX6    -3
          AX4    CCTLS/2
          BX6    -X6*X2      READ RECOVERY INDEX
          MX1    1
          IX6    X0+X6       OFFSET FOR READ RECOVERY
          SB5    X4          CHANNEL NUMBER
          TA5    X0+IOLK,CBT GET READ/WRITE FLAG
          TA4    X6+PAD1,CBT READ PHYSICAL ADDRESS
          LX1    54-59
          LX5    54-57
          SX6    B7          UNIT NUMBER
          BX5    X5*X1       READ/WRITE FLAG
          MX7    12
          LX6    48
          LX7    -12
          BX5    X5+X6       FCN, UNIT
          BX6    X7*X4       CYLINDER
          LX7    -36
          LX4    -24
          BX6    X6+X5       FCN, UNIT, CYL
          BX4    X7*X4       TRACK, SECTOR
          SX5    B5          CHANNEL NUMBER
          BX6    X6+X4       FCN, UNIT, CYL, TRACK, SECTOR
          LX5    7
          SA6    /MONITOR/MCU+X5  STORE REQUEST
 
*         INITIATE REQUEST.
 
          MX1    48
          SX7    B7          UNIT NUMBER
          TX6    A2-UNCT,-PUT SET *PUT* ENTRY PENDING
          LX1    12
          LX6    12-PUTLS
          BX3    X1*X3       CLEAR PENDING REQUEST
          SA7    A6+B1
          BX6    X6+X3       INSERT NEW PENDING REQUEST
          RI     B5          RESET I/O BUFFER POINTERS
          MX3    1
          RO     B5          SET RECORD FLAG TO *FLPP*
          BX6    X6+X3       SET CHANNEL BUSY
          SB5    B5+B1
          SA6    A3
          RI     B5          RESET BUFFER POINTERS (PARTNER CHANNEL)
          JP     B3          RETURN
 
 INR3     TX7    A2-UNCT,-PUT SET RETRY REQUEST
          MX1    48
          LX7    24-PUTLS
          LX1    24
          LX2    -6
          MX4    -59
          BX3    X1*X3       CLEAR RETRY REQUEST
          BX6    -X4*X2      CLEAR UNIT BUSY
          BX7    X7+X3       INSERT NEW RETRY REQUEST
          SA6    A2
          SA7    A3
          JP     B3          RETURN
 IOA      SPACE  4,20
**        IOA - I/O ACCEPT.
*
*         MASTER INPUT.
*
*         ENTRY  (A0) = CM BUFFER ADDRESS.
*                (B4) = CHANNEL NUMBER.
*                ((A0)+1) = UNIT NUMBER.
*
*         EXIT   (X0) = CONTROL BUFFER ORDINAL.
*                TO *INR*.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 2, 4, 5, 6, 7.
*                B - 3, 5, 6, 7.
*
*         CALLS  INR, SAA.
 
 
 IOAX     MJ                 EXIT
 
 IOA      TB7                READ REAL TIME CLOCK
          SX1    B4
          SX7    B7
          LX1    CCTLS/2
          SA4    A0+B1       GET UNIT NUMBER
          MX6    48
          SA7    RTCI        SAVE REAL-TIME CLOCK
          TA3    X1+CREQ,CCT READ CHANNEL REQUEST CONTROL
          SB7    X4          UNIT NUMBER
          SA5    A3+B1
          ERRNZ  CCNT-CREQ-1 INDEXES MUST BE CONSECUTIVE
          MX7    -59
          PL     X3,IOAX     IF CHANNEL NOT BUSY
          LX6    12
          BX3    -X7*X3      CLEAR CHANNEL BUSY
          SX2    B1
          BX3    X6*X3       CLEAR PENDING REQUEST
          RI     B4          RESET I/O BUFFER POINTERS
          SB6    B7-60
          IX5    X5+X2       INCREMENT TOTAL REQUEST COUNT
          IX6    X3+X2       INCREMENT ACTIVE REQUEST COUNT
          AX7    B6
          RI     B2          RESET I/O BUFFER POINTERS
          BX7    X7+X5       SET UNIT REQUEST FLAG
          SA6    A3
          SA7    A5+
          SB6    7
 
*         *IOA* IS ENTERED HERE BY *RIO* TO INITIATE REQUESTS ON
*         ALL CHANNELS IN USE WHEN FLUSHING WRITE BUFFERS DURING
*         RECOVERY.  EXIT IS ACCOMPLISHED BY CODE MODIFICATION.
 
 IOA1     MX2    -3
          SX6    B7+1        INCREMENT UNIT NUMBER
          BX4    -X2*X6
          SB7    X4
          LX3    X7,B7       UNIT REQUEST FLAG
          PL     X3,IOA4     IF NO REQUEST ISSUED
 IOA2     SB6    B6-1
          NZ     B6,IOA1     IF NOT END OF UNITS
 IOA3     SB3    IOAX        *SAA* RETURN ADDRESS
*         EQ     RIO2        (BUFFER RECOVERY IN PROGRESS)
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 
 IOA4     SB5    B7-4
          SX3    A5+CUN1-CCNT
          NG     B5,IOA5     IF UNITS 0 - 3
          SX3    X3+CUN2-CUN1
 IOA5     SA2    X3          GET *PUT* ORDINAL
          SX6    B7          COMPUTE BYTE OFFSET
          ZR     X2,IOA2     IF NO UNITS DEFINED
          MX4    -2
          SX5    12
          BX4    -X4*X6
          IX6    X4*X5
          SB5    X6
          MX4    -12
          AX2    B5
          BX6    -X4*X2      *PUT* ORDINAL
          ZR     X6,IOA2     IF NO UNIT DEFINED
          LX6    PUTLS
          TA2    X6+UNCT,PUT READ *PUT* ENTRY
          NG     X2,IOA2     IF UNIT BUSY
          MX4    1
          MX5    -12
          BX6    X4+X2       SET UNIT BUSY
          LX2    -12
          BX0    -X5*X2
          ZR     X0,IOA2     IF EMPTY QUEUE
          SA6    A2
          SB3    IOA3        *INR* RETURN ADDRESS
          EQ     INR         INITIATE REQUEST
 IOL      SPACE  4,25
**        IOL - I/O LINKUP.
*
*         XP     SLAVE INPUT.
*
*         ENTRY  (A1) = PARTNER XP ADDRESS.
*                (A0) = CM BUFFER ADDRESS.
*                (B2) = CHANNEL NUMBER (PARTNER).
*                (B4) = CHANNEL NUMBER.
*                ((A0)) = *FLPP* REPLY.
*
*         EXIT   (A2) = *PUT* ENTRY ADDRESS.
*                (A3) = CONTROL BUFFER ADDRESS.
*                (X0) = LCM BUFFER ADDRESS.
*                (X2) = *PUT* ENTRY.
*                TO *RDD* (READ)  OR *WRT* (WRITE).
*
*         USES   X - ALL.
*                A - 2, 3, 5, 6, 7.
*                B - 3, 5, 7.
*
*         CALLS  DCS, RDD, SAA, WRT.
 
 
 IOLX     MJ                 EXIT
 
 IOL      TB7                READ REAL-TIME CLOCK
          SX2    B2          CHANNEL NUMBER
          SX7    B7
          LX2    CCTLS/2
          SA7    RTCI        SAVE REAL-TIME CLOCK AT INTERRUPT
          TA3    X2+CREQ,CCT READ CHANNEL CONTROL TABLE
          MX6    -12
          BX7    -X6*X3      ACTIVE REQUESTS
          ZR     X7,IOLX     IF NO ACTIVE REQUESTS
          MX4    1
          LX6    12
          BX7    X3+X4       SET CHANNEL BUSY
          BX3    -X6*X3      PENDING REQUEST
          ZR     X3,IOL1     IF NO PENDING REQUEST ISSUED
          MX6    36
          AX3    12-PUTLS
          LX6    12
          TA2    X3+UNCT,PUT READ *PUT* ENTRY
          BX7    X6*X7       CLEAR RETRY REQUEST
          LX3    24-PUTLS
          BX7    X3+X7       INSERT NEW RETRY REQUEST
          BX6    -X4*X2      CLEAR UNIT BUSY
          SA6    A2
 IOL1     SB3    IOL2        *SAA* RETURN ADDRESS
          SA2    B0          SET I/O LINKUP SEQUENCE
          RO     B4          SIGNAL *FLPP*
          SA7    A3
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 
 IOL2     MJ                 EXIT
 
*         SECOND I/O LINKUP INTERRUPT, OR STATUS REPLY.
*
*         (A2) = 0  IF I/O LINKUP SEQUENCE.
*         (A2) = *PUT* ENTRY ADDRESS, IF STATUS REPLY.
 
 IOL3     TB3                READ REAL-TIME CLOCK
          SX6    A2+
          SX7    B3
          SA7    RTCI        SAVE REAL-TIME CLOCK AT INTERRUPT
          NZ     X6,DCS      IF STATUS REPLY
          SA2    A0+         GET *FLPP* REPLY
          SX5    A3+B1
          ERRNZ  CCNT-CREQ-1 INDEXES MUST BE CONSECUTIVE
          MX3    12
          RI     B4
          BX0    X3*X2
          RI     B2          RESET I/O BUFFER POINTERS
          LX2    18
          SX3    4
          SB5    X2          FUNCTION
          LX2    6
          BX3    X3*X2
          ZR     X3,IOL4     IF UNITS 0-3
          SX5    X5+B1
          ERRNZ  CUN2-CUN1-1 INDEXES MUST BE CONSECUTIVE
 IOL4     SA5    X5+B1       READ UNIT LIST
          ERRNZ  CUN1-CCNT-1 INDEXES MUST BE CONSECUTIVE
          MX3    -2          COMPUTE UNIT OFFSET
          SX4    12
          BX3    -X3*X2
          IX3    X3*X4
          SB7    X3
          AX5    B7          POSITION *PUT* ORDINAL
          MX4    -12
          BX3    -X4*X5
          LX3    PUTLS
          MX1    -24
          TA2    X3+UNCT,PUT READ *PUT* ENTRY
          LX2    -12
          BX4    -X4*X2      CURRENT
          LX2    12
          LX4    CBTLS
          TA5    X4+IOLK,CBT
          TA3    X4+PAD1,CBT SET CONTROL BUFFER ADDRESS
          PL     X5,IOL6     IF I/O INTERLOCK CLEAR
          SX3    B1
          LX5    -57
          BX3    X5*X3
          SX4    B5          FUNCTION
          IX4    X4-X3
          NZ     X4,IOL6     IF FUNCTIONS DO NOT MATCH
          MX3    1
          BX7    X7-X7
          BX6    X3+X5       SET I/O LINKUP
          SA7    A0          SET *GO* TO *FLPP*
          LX6    57
          SA6    A5
          NZ     X0,DCS      IF ABORT DURING I/O LINKUP
          RO     B2          SIGNAL MASTER *FLPP*
 IOL5     OB7    B2
          ZR     B7,IOL5     IF MASTER HAS NOT ACCEPTED
          BX0    -X1*X6      I/O BUFFER ADDRESS
          NZ     B5,WRT      IF WRITE
          EQ     RDD         READ
 
 IOL6     NZ     X0,DCS      IF ABORT DURING I/O LINKUP
          EQ     *           HANG
 RAB      SPACE  4,20
**        RAB - READ ABORT PROCESSOR.
*
*         XP     SLAVE INPUT.
*
*         ENTRY  (A0) = CM BUFFER ADDRESS.
*                (A1) = PARTNER XP ADDRESS.
*                (A2) = *PUT* ENTRY ADDRESS.
*                (A3) = CONTROL BUFFER ADDRESS.
*                (B4) = CHANNEL NUMBER.
*                (B5) = READ RECOVERY INDEX.
*                (X0) = LCM BUFFER ADDRESS.
*
*         EXIT   TO *DCS*.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 2, 3, 4, 5, 6, 7.
*                B - 6, 7.
 
 
 RAB      SA5    A1          RESET MASTER XP
          SA4    A0          GET STATUS
          SX3    IOA         NEW (P)
          MX6    -36
          LX3    36
          BX6    -X6*X5      CLEAR OLD (P)
          LX4    59-58
          BX6    X6+X3       INSERT NEW (P)
          MX7    1
          SA6    A5
          MX1    -3
          PL     X4,DCS      IF NOT A READ ERROR
          SA5    A1+5        READ MASTER XP
          BX5    -X1*X5      (B5) = READ RECOVERY INDEX
          SA2    A2          READ *PUT* ENTRY
          ERRNZ  UNCT        INDEX MUST BE ZERO
          LX1    -6
          SB7    X5
          BX2    X1*X2
          GT     B7,B5,RAB1  IF MASTER NEXT
          SX5    B5
 RAB1     SB6    X5-1
          SB7    X5-PSLB
          LX5    54
          SA4    A3+B6       ADDRESS OF SECTOR IN ERROR
          MX1    2
          LX1    23-59
          BX6    X1*X4       CLEAR VALID DATA FLAGS
          BX6    -X6
          BX6    X1*X6
          BX6    X6+X4
          SA6    A4
          NG     B7,RAB2     IF NOT LAST SECTOR
          BX5    X5-X5       CLEAR NEW READ RECOVERY INDEX
 RAB2     BX7    X5+X2       SET NEW READ RECOVERY INDEX
          SA7    A2
          SX7    B4+         CLEAR POSSIBLE CONTINUATION REQUEST
          AX7    CCTLS/2
          MX6    1
          SA6    NRQT-1+X7
          EQ     DCS         DECODE STATUS
 RDD      SPACE  4,15
**        RDD - READ DISK.
*
*         ENTRY  (A0) = CM BUFFER ADDRESS.
*                (A1) = PARTNER XP ADDRESS.
*                (A2) = *PUT* ENTRY ADDRESS.
*                (A3) = CONTROL BUFFER ADDRESS.
*                (X0) = LCM BUFFER ADDRESS.
*                (X2) = *PUT* ENTRY.
*
*         USES   X - ALL.
*                A - ALL.
*                B - 3, 5, 6, 7.
*
*         CALLS  /BUFIO/DLB, FNR, RAB, SAA, /BUFIO/SBR, SCB.
 
 
 RDD      SA1    A1          SET UP PARTNER XP
          SA4    A1+2
          MX6    -3
          LX2    6
          SX7    RDD3        ENTRY ADDRESS FOR MASTER XP
          SA5    A4+B1
          BX2    -X6*X2      RECOVERY INDEX
          MX3    42
          LX7    36
          LX3    18
          SB5    X2          RECOVERY INDEX
          BX4    X3*X4       CLEAR (A2)
          BX5    X3*X5       CLEAR (A3)
          SX6    A2
          SX3    A3
          LX6    18
          LX3    18
          BX6    X4+X6       INSERT NEW (A2)
          SA6    A4
          SA4    A1+5
          BX6    X5+X3       INSERT NEW (A3)
          SB7    B5-PSLB+1
          SA6    A5
          MX3    42
          MX5    -36
          SX6    X2+B1       RECOVERY INDEX FOR PARTNER
          BX4    X3*X4       CLEAR (B5)
          BX1    -X5*X1      CLEAR (P)
          BX6    X6+X4       INSERT NEW (B5)
          BX7    X7+X1       INSERT NEW (P)
          SA6    A4+
          LX2    9
          SA7    A1+
          IX0    X0+X2       OFFSET LCM ADDRESS BY RECOVERY INDEX
          NZ     B7,RDD1     IF NOT LAST SECTOR
          MX7    1
          SA7    A0
 RDD1     SX4    1000B
          SB3    RDD2        *SAA* RETURN ADDRESS
          IX6    X0+X4
          RO     B2          SIGNAL MASTER
          SA6    A1+10B      SET NEW (X0)
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 
 RDD2     MJ                 EXIT
 
*         FIRST INTERRUPT.
 
 RDD3     TB7                READ REAL-TIME CLOCK
          IB3    B4          CHECK FOR FULL BUFFER
          SA4    A0          READ HEADER
          MX5    2
          SB6    200B
          SX7    B7
          LX5    -12
          SB3    B3-B6
          BX6    X5*X4       UNIT NUMBER
          SA7    RTCI        SAVE REAL-TIME CLOCK AT INTERRUPT
          NG     B3,RAB      IF READ ABORT
          SA0    A0+B1
          BX4    -X5*X4      CLEAR UNIT
          WE     177B
+         LX6    2
          SX2    177B
          BX6    X6+X4       INSERT UNIT NUMBER
          IX0    X0+X2       INCREMENT LCM ADDRESS
          SA0    A0+177B     INCREMENT CM ADDRESS
          SA6    A3+B5       SET HEADER IN CONTROL BUFFER
          SB3    RDD4        *SAA* RETURN ADDRESS
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 
 RDD4     MJ                 EXIT
 
*         SECOND INTERRUPT.
 
          TB7                READ REAL-TIME CLOCK
          SX2    200B
          SX7    B7
          WE     200B
+         SA7    RTCI        SAVE REAL-TIME CLOCK AT INTERRUPT
          SA0    A0-B6       RESET CM ADDRESS
          IX0    X0+X2       INCREMENT LCM ADDRESS
          SB3    RDD5        *SAA* RETURN ADDRESS
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 
 RDD5     MJ                 EXIT
 
*         THIRD INTERRUPT.
 
          TB7                READ REAL-TIME CLOCK
          BX7    X7-X7       *GO* FOR NEXT SECTOR
          SB3    PSLB-2      CHECK FOR NEXT TO LAST SECTOR
          WE     200B
+         SX6    B7
          IX0    X0+X2       INCREMENT LCM ADDRESS
          SA6    RTCI        SAVE REAL-TIME CLOCK AT INTERRUPT
          SA0    A0+B6       INCREMENT CM ADDRESS
          NE     B3,B5,RDD6  IF NOT NEXT TO LAST SECTOR
          SB7    B0          SET READ PROCESSING FOR *FNR*
          SB3    RDD6        *FNR* RETURN ADDRESS
          EQ     FNR         FIND NEXT REQUEST
 
 RDD6     SB3    RDD7        *SAA* RETURN ADDRESS
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 
 RDD7     MJ                 EXIT
 
*         FOURTH INTERRUPT.
 
          TB7                READ REAL-TIME CLOCK
          SX2    B6
-         WL     200B
          SX6    B7
          SA0    A0-B6       RESET CM ADDRESS
          SA6    RTCI        SAVE REAL-TIME CLOCK AT INTERRUPT
 RDD8     IB3    B4
          SA5    A0
          NE     B3,B1,RDD8  IF LAST WORD NOT PRESENT
          IX0    X0+X2       INCREMENT LCM ADDRESS
          SB5    B5+2        INCREMENT SECTOR COUNT
          SX2    B1
          WX5    X0          WRITE LAST WORD TO BUFFER
          SX4    1000B
          IX0    X0+X2
          SA7    A0+         SEND CONTROL WORD TO *FLPP*
          SB3    PSLB+1
          RI     B4          RESET I/O BUFFER POINTERS
          IX0    X0+X4       INCREMENT LCM BUFFER ADDRESS
          RO     B4
          MX7    -57
          EQ     B3,B5,RDD9  IF LAST SECTOR
          SB3    RDD2        *SAA* RETURN ADDRESS
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 
 RDD9     SA2    A2          READ *PUT* ENTRY
          ERRNZ  UNCT        INDEX MUST BE ZERO
          LX7    -3
          SB3    RDD10       *DLB* RETURN ADDRESS
          BX2    -X7*X2      CLEAR RECOVERY INDEX
          EQ     /BUFIO/DLB  DELETE BUFFER
 
 RDD10    SB3    RDD11       *SRC* RETURN ADDRESS
          SB7    B0+         SET INPUT XP
          EQ     /BUFIO/SBR  SET BUFFER RECALL
 
 RDD11    SX2    B4          GET NEXT REQUEST
          SA5    A1+5        CLEAR PARTNER SECTOR COUNT
          AX2    CCTLS/2
          MX0    42
          SA4    NRQT-1+X2
          BX6    X0*X5       CLEAR (B5)
          MX1    -24
          SA6    A5
          SA3    X4          READ NEXT CONTROL BUFFER
          SX7    X4          CONTROL BUFFER ADDRESS
          BX2    X4
          SA5    A1+3
          LX0    18
          SA4    X4+IOLK
          LX7    18
          BX5    X0*X5       CLEAR (A3)
          BX6    -X1*X4      LCM BUFFER ADDRESS
          BX7    X5+X7       INSERT NEW (A3)
          SA4    A2+RDST     UPDATE READ STATISTICS
          SX5    PSLB        PHYSICAL SECTOR COUNT
          SA6    A1+10B      SET NEW (X0)
          SA7    A5+
          SX0    1000B
          SB7    59-35
          SB5    B1
          IX7    X4+X5       INCREMENT ACCUMLATOR
          IX0    X0+X6       LCM BUFFER ADDRESS
          LX1    X7,B7
          SB3    RDD13       *RXB* *SCB* RETURN ADDRESS
          NG     X1,RDD12    IF ACCUMULATOR OVERFLOW
          SA7    A4+         UPDATE ACCUMULATOR
 RDD12    NG     X2,RXP      IF NOT CONTINUING ON NEXT REQUEST
          EQ     SCB         SET CURRENT BUFFER
 
 RDD13    SB3    RDD2        *SAA* RETURN ADDRESS
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 RPP      SPACE  4,10
**        RPP - REQUEST PSEUDO-PP.
*
*         ENTRY  (A4) = FWA OF CONTROL BUFFER + *LSLK*.
*                (B3) = RETURN ADDRESS.
*                (B4) = CHANNEL NUMBER.
*                (B7) = 0  IF INPUT XP, 20B  IF OUTPUT XP.
*
*         USES   X - 3, 4, 5, 6, 7.
*                A - 5, 6, 7.
 
 
 RPP      SX4    B4          COMPUTE XP ADDRESS
          LX4    5
          SX4    X4+B7
          SX3    B1
          SA5    /MONITOR/MCU+X4+3  READ PSD
          LX3    39
          BX6    X3+X5       SET STEP MODE FLAG
          SA6    A5+
          TX7    A4-LSLK,-CBT  COMPUTE CONTROL BUFFER ORDINAL
          SA5    BMRI        GET REQUEST QUEUE INDEX
          AX7    3
          SX6    X5+B1       INCREMENT INDEX
          SA7    TBMR+X5     SET REQUEST IN QUEUE
          SA6    A5+
          JP     B3          RETURN
 RXP      SPACE  4,10
**        RXP - RESET EXCHANGE PACKAGES.
*
*         ENTRY  (A1) = PARTNER XP ADDRESS.
*                (B3) = RETURN ADDRESS.
*                (B4) = CHANNEL NUMBER.
*
*         USES   X - 2, 3, 4, 6, 7.
*                A - 4, 7.
*                B - 3.
*
*         CALLS  SAA.
 
 
 RXP      SX2    B4          CHANNEL NUMBER
          SX3    B1
          SX7    IOA
          BX3    X3*X2
          MX6    -36
          SB3    IOL2        *SAA* RETURN ADDRESS
          SA4    A1+
          NZ     X3,RXP1     IF IN SLAVE
          SX7    IOL3
          SB3    IOAX        *SAA* RETURN ADDRESS
 RXP1     LX7    36
          BX6    -X6*X4
          BX7    X7+X6       INSERT NEW (P)
          SA7    A4
          ERRNZ  SAA-*       SUBROUTINES MUST BE CONSECUTIVE
*         EQ     SAA
 SAA      SPACE  4,10
**        SAA - SET ACCOUNTING ADJUSTMENT.
*
*         ENTRY  (B3) = RETURN ADDRESS.
*                (RTCI) = REAL-TIME CLOCK AT INTERRUPT.
*
*         USES   X - 3, 4, 5, 6.
*                A - 4, 5, 6.
*                B - 7.
 
 
 SAA      SA4    RTCI        REAL-TIME CLOCK AT INTERRUPT
          SA5    CL+CPBT     PROGRAM MODE BASE TIME OF ACTIVE JOB
          TB7                READ REAL-TIME CLOCK
          MX6    -18
          SX3    B7
          BX4    -X6*X4
          BX6    -X6*X3
          IX6    X6-X4       COMPUTE ACCOUNTING ADJUSTMENT
          SX6    X6+80D      ADJUST FOR NON-TIMED CODE
          IX6    X5+X6       ADJUST START TIME
          SA6    A5
          JP     B3          RETURN
 SCB      SPACE  4,10
**        SCB - SET CURRENT BUFFER.
*
*         ENTRY  (A2) = *PUT* ENTRY ADDRESS.
*                (A3) = CONTROL BUFFER ADDRESS.
*                (B3) = RETURN ADDRESS.
*
*         USES   X - 2, 5, 6.
*                A - 2, 6.
 
 
 SCB      SA2    A2          *PUT* ENTRY
          MX6    48
          TX5    A3,-CBT     COMPUTE CONTROL BUFFER ORDINAL
          LX6    12
          LX5    12-CBTLS
          BX6    X6*X2       CLEAR CURRENT
          BX6    X5+X6       INSERT NEW CURRENT
          SA6    A2
          JP     B3          RETURN
 WRT      SPACE  4,15
**        WRT - WRITE DISK.
*
*         ENTRY  (A0) = CM BUFFER ADDRESS.
*                (A1) = PARTNER XP ADDRESS.
*                (A2) = *PUT* ENTRY ADDRESS.
*                (A3) = CONTROL BUFFER ADDRESS.
*                (X0) = LCM BUFFER ADDRESS.
*                (X2) = *PUT* ENTRY.
*
*         USES   X - ALL.
*                A - 0, 2, 3, 4, 5, 6, 7.
*                B - 3, 5, 6, 7.
*
*         CALLS  /BUFIO/DLB, FNR, SAA, SCB, /BUFIO/SBR.
 
 
 WRT      SA4    A1+20B+2    SET UP PARTNER XP
          MX6    42
          SA3    A3          READ CONTROL BUFFER
          ERRNZ  PAD1        CODE DEPENDS ON VALUE
          MX1    2
          LX6    18
          SA5    A4+B1
          LX1    49-59
          MX7    -48
          BX4    X6*X4       CLEAR (A2)
          BX1    X1*X3       UNIT NUMBER
          BX7    -X7*X3      CLEAR FLAGS
          LX1    -2
          BX5    X6*X5       CLEAR (A3)
          BX7    X1+X7       INSERT UNIT NUMBER
          SX6    A2
          SA7    A0          SET HEADER WORD IN SECTOR
          LX6    18
          SA0    A0+B1
          SX7    A3
          BX6    X6+X4       INSERT NEW (A2)
          LX7    18
          SA6    A4
          BX7    X7+X5       INSERT NEW (A3)
          SX3    377B
-         RL     377B        FILL CM BUFFER
          SA7    A5
          IX6    X0+X3
          SA4    A1+20B+5
          SA6    A1+20B+10B  SET (X0)
          MX5    42
          SA0    A0-B1       RESET CM BUFFER ADDRESS
          BX7    X5*X4       CLEAR (B5) = READ RECOVERY INDEX
          SB3    IOL2        *SAA* RETURN ADDRESS
          SA7    A4
          RO     B2          SIGNAL MASTER FLPP
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 
 WRTX     MJ                 EXIT
 
*         FIRST INTERRUPT.
 
 WRT1     TB7                READ REAL-TIME CLOCK
          SB3    WRT2        *SAA* RETURN ADDRESS
          SX7    B7
          SB6    200B        ADDRESS INCREMENT
          SA7    RTCI        SAVE REAL-TIME CLOCK AT INTERRUPT
          SX2    B6+
-         RL     200B
          IX0    X0+X2       INCREMENT LCM ADDRESS
          SA0    A0+B6       INCREMENT CM ADDRESS
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 
 WRT2     MJ                 EXIT
 
*         SECOND INTERRUPT.
 
          TB7                READ REAL-TIME CLOCK
          SB3    WRT3        *SAA* RETURN ADDRESS
          SX7    B7
          SA7    RTCI        SAVE REAL-TIME CLOCK AT INTERRUPT
-         RL     200B
          IX0    X0+X2       INCREMENT LCM ADDRESS
          SA0    A0-B6       RESET CM ADDRESS
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 
 WRT3     MJ                 EXIT
 
*         THIRD INTERRUPT.
 
          TB7                READ REAL-TIME CLOCK
          RX6    X0          READ LAST WORD
          SB3    PSLB-1
          SX7    B7
          SB5    B5+B1       INCREMENT SECTOR COUNT
          SA7    RTCI        SAVE REAL-TIME CLOCK AT INTERRUPT
          SB7    B1          *FNR* CONTROL
          SX7    B1
          SA6    A0          LAST WORD OF SECTOR TO BUFFER
          IX0    X0+X7
          EQ     B3,B5,WRT6  IF NEXT TO LAST SECTOR
          SB3    B3+B1
          BX7    X7-X7       *GO*
          NE     B3,B5,WRT7  IF NOT LAST SECTOR
          SB3    WRT4        *DLB* RETURN ADDRESS
          SA2    A2          *PUT* ENTRY
          ERRNZ  UNCT        INDEX MUST BE ZERO
          EQ     /BUFIO/DLB  DELETE BUFFER
 
 WRT4     SB3    WRT5        *SRC* RETURN ADDRESS
          SB6    200B        RESET B6
          SB7    20B         SET OUTPUT XP
          EQ     /BUFIO/SBR  SET BUFFER RECALL
 
 WRT5     SA5    A2+WTST     UPDATE WRITE STATISTICS
          SX6    PSLB        PHYSICAL SECTOR COUNT
          SX7    B4          CHANNEL NUMBER
          IX6    X5+X6       INCREMENT ACCUMULATOR
          AX7    1
          LX6    59-35
          SA4    NRQT-1+X7   CHECK FOR CONTINUATION
          SB5    B0+         CLEAR READ RECOVERY INDEX
          NG     X6,WRT5.1   IF ACCUMULATOR OVERFLOW
          LX6    35-59
          SA6    A5          UPDATE ACCUMULATOR
 WRT5.1   NG     X4,WRT10    IF END OF TRANSFER
          SA3    X4
          SX6    A1          SET NEW CONTROL BUFFER INDEX IN XP
          SA5    X4+IOLK
          MX7    54
          MX2    -24
          BX3    X7*X6
          BX0    -X2*X5
          BX7    X7-X7       PRESET *CONTINUE*
          MX2    42
          SA5    X3+40B+3
          SB3    WRT7        *SCB* RETURN ADDRESS
          SX3    A3
          LX2    18
          LX3    18
          BX6    X2*X5       CLEAR (A3)
          BX6    X6+X3       INSERT NEW (A3)
          SA6    A5
          EQ     SCB         SET CURRENT BUFFER
 
 WRT6     SB3    WRT7        *FNR* RETURN ADDRESS
          EQ     FNR         FIND NEXT REQUEST
 
 WRT7     SA0    A0+1
          SX2    177B
          RE     177B
+         SB3    WRT8        *SAA* RETURN ADDRESS
          IX0    X0+X2       INCREMENT LCM ADDRESS
          SX2    B6
          SA0    A0+177B     INCREMENT CM ADDRESS
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 
 WRT8     MJ                 EXIT
 
*         FOURTH INTERRUPT.
 
          TB7                READ REAL-TIME CLOCK
          MX1    2
          SA5    A3+B5       GET HEADER FOR NEXT SECTOR
          MX3    -48
          LX1    -10
          SX6    B7
-         RL     200B
          SA6    RTCI        SAVE REAL-TIME CLOCK AT INTERRUPT
          BX1    X1*X5       UNIT NUMBER
          BX3    -X3*X5
          LX1    -2
          SA0    A0-B6       RESET CM ADDRESS
          BX3    X1+X3       INSERT UNIT NUMBER
          IX0    X0+X2
 WRT9     OB3    B4
          ZR     B3,WRT9     IF LAST WORD STILL PRESENT
          BX7    X7+X3
          SA7    A0
          RO     B2          RESET I/O BUFFER POINTERS
          SA4    A1+2        RESET PARTNER XP
          SA5    A1+3
          BX6    X0
          SX2    A2
          SA6    A1+10B      SET (X0) IN PARTNER XP
          LX2    18
          MX1    42
          SX3    A3
          LX1    18
          LX3    18
          BX4    X1*X4       CLEAR (A2)
          BX5    X1*X5       CLEAR (A3)
          BX6    X4+X2       INSERT NEW (A2)
          BX7    X5+X3       INSERT NEW (A3)
          SA6    A4
          SA7    A5
          MX1    42
          SA4    A1+5
          SX6    B5
          SB3    WRTX        *SAA* RETURN ADDRESS
          BX4    X1*X4       CLEAR (B5)
          BX6    X4+X6       INSERT NEW (B5)
          SA6    A4
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 
 WRT10    SB3    WRT11       *SAA* RETURN ADDRESS
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 
 WRT11    MJ                 EXIT
 
          TB7                READ REAL-TIME CLOCK
          RO     B2          INDICATE TRANSFER COMPLETE TO *FLPP*
          SX7    B7+
          SB3    WRTX        *SAA* RETURN ADDRESS
          SA7    RTCI        SAVE REAL-TIME CLOCK AT INTERRUPT
          EQ     SAA         SET ACCOUNTING ADJUSTMENT
 
          ENDBLK
          BLOCK  DCP,(DUAL CPU OPERATION.)
 PCXF     SPACE  4,15
**        PCXF - PROCESS CPU EXCHANGE REQUEST.
*
*         ENTRY
*T, X0    42/,18/  PCXF
*                (X5) = MONITOR MODE ENTRY TIME IF 180 MACHINE.
*
*         EXIT   TO */MONITOR/PMN4*.
*
*         USES   X - 1, 2, 3, 4, 7.
*                A - 1, 7.
*                B - 3.
 
 PCX      SA1    CL+CACX+A0  READ REQUEST WORD
          NX3,B3 X1          SET PPU NUMBER
          SX4    B1
          ZR     X1,/MONITOR/MTRX  IF NO REQUESTS PRESENT
          LX4    47
          SX2    B3          SET OUTPUT REGISTER OFFSET
          AX3    X4,B3
          BX7    X1-X3
          LX2    3
          SA7    A1
          TX0    X2+1,FP     SET OUTPUT REGISTER ADDRESS
          EQ     /MONITOR/PMN4  PROCESS FUNCTION
 ACQ      SPACE  4,10
**        ACQ - *ACQ* PREPROCESSOR FOR DUAL CPU CACHE MACHINE.
*
*         ENTRY  JOB ACTIVE IN THIS CPU.
*                (B7) = CONTROL POINT ADDRESS.
*
*         USES   X - 1.
*                A - 1.
*                B - 6.
*
*         EXIT   TO *ACQ* VIA *CCC*.
 
 
 ACQ      BSS    0           ENTRY
          SA1    B7+CWQW
          SB6    /BUFIO/ACQ  SET EXIT ADDRESS
          EQ     CCC         CHECK CACHE MACHINE CPU SELECTION
 APQ      SPACE  4,10
**        APQ - *APQ* PREPROCESSOR FOR DUAL CPU CACHE MACHINE.
*
*         ENTRY  JOB ACTIVE IN THIS CPU.
*                (B7) = CONTROL POINT ADDRESS.
*
*         USES   X - 1.
*                A - 1.
*                B - 6.
*
*         EXIT   TO *APQ* VIA *CCC*.
 
 
 APQ      BSS    0           ENTRY
          SA1    B7+CWQW
          SB6    /MONITOR/APQ  SET EXIT ADDRESS
          EQ     CCC         CHECK CACHE MACHINE CPU SELECTION
 CCA      SPACE  4,15
**        CCA - DUAL CPU CACHE MACHINE *CCAM* PROCESSOR.
*
*         ENTRY  JOB ACTIVE IN THIS CPU IF CPU 1.
*                (B3) = *JAV* RETURN ADDRESS.
*                (B7) = OLD CONTROL POINT ADDRESS.
*                (X6) = OLD CONTROL POINT *STSW*.
*                (B6) = NEW CONTROL POINT ADDRESS.
*                (X0) .GE. 0 IF OLD CP/PCP IS SYSTEM CP OR PCP.
*
*         EXIT   TO */MONITOR/JAV* IF OLD CP JOB ADVANCE TO BE CHECKED.
*                TO *PPRX* IF OLD CP JOB ADVANCE NOT TO BE CHECKED.
*                (B7) = OLD CONTROL POINT ADDRESS.
*
*         USES   X - 1, 2.
*                A - 1.
*                B - 4, 6.
 
 
 CCA      BSS    0           ENTRY
          TX2    B6,-SCA
          PL     X0,CCA1     IF OLD CP/PCP IS SYSTEM CP OR PCP
          SB4    CCA1        SET *CPA* RETURN ADDRESS
          EQ     CPA         CHECK OLD CP ACTIVITY
 
 CCA1     SA1    B6+CWQW
          SB6    /MONITOR/JAV  SET TO CHECK ADVANCE ON OLD CP
          NG     X0,CCA2     IF OLD CP/PCP IS NOT SYSTEM CP OR PCP
          SB6    /MONITOR/PPRX  SET TO NOT CHECK ADVANCE ON OLD CP
 CCA2     PL     X2,/MONITOR/RB6  IF NEW CP/PCP IS SYSTEM CP OR PCP
*         EQ     CCC         CHECK NEW CP CPU SELECTION
 CCC      SPACE  4,15
**        CCC - CHECK CPU SELECTION FOR DUAL CPU CACHE MACHINE.
*
*         ENTRY  JOB ACTIVE IN THIS CPU.
*                (B6) = EXIT ADDRESS.
*                (X1) = *CWQW*.
*                (A1) = ADDRESS OF *CWQW*.
*
*         EXIT   ASSIGNMENT OF CPU 1 PROHIBITED.
*                CPU SWITCH REQUESTED IF EXECUTING IN CPU 1.
*
*         USES   X - 1, 2, 7.
*                A - 1, 7.
 
 
 CCC      BSS    0           ENTRY
          SX7    B1
          SX2    A0
          LX7    24-0
          BX7    X1+X7       DISALLOW ASSIGNMENT OF CPU 1
          SA7    A1
          ZR     X2,/MONITOR/RB6  IF JOB IN CPU 0
          MX7    1
          SA1    CSWL+A0
          BX7    X7+X1       SET CPU SWITCH REQUEST
          SA7    A1
          JP     B6          EXIT TO SPECIFIED ROUTINE
 CPA      SPACE  4,15
**        CPA - CHECK PP AND TAPE ACTIVITY FOR DUAL CPU CACHE MACHINE.
*
*         ENTRY  (B4) = RETURN ADDRESS.
*                (X6) = *STSW*.
*                (B7) = CONTROL POINT ADDRESS.
*
*         EXIT   CPU ASSIGNMENT FLAGS RESTORED FROM USER CPU SELECTION
*                  IF NO PP OR TAPE ACTIVITY.
*                (X6) = *STSW*.
*                (B7) = CONTROL POINT ADDRESS.
*
*         USES   X - 1, 3, 7.
*                A - 1, 3, 7.
 
 CPA      BSS    0           ENTRY
          TX1    B7,-SCA
          PL     X1,/MONITOR/RB4  IF SYSTEM CP OR PCP
          SX7    360B
          MX1    4
          LX1    48-56
          BX7    X7+X1
          BX7    X7*X6
          NZ     X7,/MONITOR/RB4  IF REMAINING PP OR TAPE ACTIVITY
          SA1    B7+JCIW
          SA3    B7+CWQW
          MX7    58
          LX7    24
          LX1    24-36
          BX3    X7*X3       CLEAR CPU ASSIGNMENT FLAGS
          BX1    -X7*X1      CPU SELECTION
          BX7    X3+X1       RESET CPU ASSIGNMENT FLAGS
          SA7    A3+
          JP     B4          RETURN
 CPE      SPACE  4,10
**        CPE - CPU SELECTION.
*
*         ENTRY  (B6) = EXIT ADDRESS.
*                (B7) = CONTROL POINT ADDRESS.
*
*         USES   A - 4.
*                B - 4.
*                X - 4, 6.
 
 
 CPE      BSS    0           ENTRY
          SB4    A0-CPAL-1   CHECK IF JOB IS ACTIVE IN THE OPPOSITE CPU
          TX6    B7,-SCA     CHECK FOR SYSTEM CONTROL POINT
          SA4    -B4
          ZR     X6,CPE1     IF SYSTEM CONTROL POINT
          AX4    24
          SB4    X4+
          EQ     B4,B7,SAX   IF JOB ACTIVE IN OPPOSITE CPU
 CPE1     JP     B6          RETURN
 CPS      SPACE  4
**        CPS - CPU SELECTION.
*
*         ENTRY FROM PPR.
 
 
 CPS      BSS    0           ENTRY
          SB4    A0-CPAL-1   CHECK IF JOB IS ACTIVE IN THE OPPOSITE CPU
          TX6    B7,-SCA     CHECK FOR SYSTEM CONTROL POINT
          SA4    -B4
          ZR     X6,CPS1     IF SYSTEM CONTROL POINT
          AX4    24
          SB4    X4+
          EQ     B4,B7,SAX   IF JOB ACTIVE ON OPPOSITE CPU
 
**        EXIT TO PROCESSOR WITH -
*         (X1) = BITS 0 - 47 OF OUTPUT REGISTER.
*         (X2) = *ACPP*.
*         (X3) = PROCESOR CONTROL WORD.
*         (X5) = OUTPUT REGISTER.
*         (X7) = 0.
*         (A2) = *ACPP* ADDRESS.
*         (B6) = PROCESSOR ADDRESS.
*         (B7) = CONTROL POINT ADDRESS.
 
 CPS1     TJP    (/PROBE/PPR,PROBE,B6)  PROCESS REQUEST
 DCP      SPACE  4,20
**        DCP - DUAL CPU *DCPM* FUNCTION PROCESSOR.
*
*         EXIT   TO /MONITOR/DCP3.
*
*         ENTRY  (X3) = *CWQW*.
*                (A3) = *CWQW* ADDRESS.
*                (X4) = 42 BIT MASK LEFT JUSTIFIED.
*
*         EXIT   TO */MONITOR/DCP3*.
*                (X3) = *CWQW*.
*                (A3) = *CWQW* ADDRESS.
*                (X4) = 42 BIT MASK LEFT JUSTIFIED.
*
*         USES   X - 2, 6.
*                A - 2, 6.
*                B - 4.
 
 
*         CLEAR *WQ* POINTER FROM PENDING CPU SWITCH REQUEST.
 
 DCP      SA2    CSWL        CPU 0 SWITCH REQUEST
          LX2    -24
          SB4    X2
          SB4    A3-B4
          ZR     B4,DCP1     IF SWITCH REQUEST FOR THIS JOB
          SA2    A2+B1       CPU 1 SWITCH REQUEST
          LX2    -24
          SB4    X2+
          SB4    A3-B4
          NZ     B4,/MONITOR/DCP3  IF NOT SWITCH REQUEST FOR THIS JOB
 DCP1     BX6    X4*X2       CLEAR *WQ* POINTER FROM SWITCH REQUEST
          LX6    24
          SA6    A2+
          EQ     /MONITOR/DCP3  REMOVE *WQ* ENTRY
 SJC      SPACE  4,20
**        SJC - DUAL CPU CACHE MACHINE *SJCM* FUNCTION PROCESSOR.
*
*         ENTRY  (X6) = *CWQW* WITH NEW CPU SELECTION.
*                (A2) = *JCIW* ADDRESS.
*                (X2) = *JCIW*.
*                (X5) = NEW CPU SELECTION LEFT SHIFTED 24 BITS.
*                (X3) = CPU SELECTION MASK LEFT SHIFTED 24 BITS.
*
*         EXIT   TO /MONITOR/SJC3.
*                (X6) = *CWQW* WITH NEW CPU SELECTION.
*                (A2) = *JCIW* ADDRESS.
*                (X2) = *JCIW*.
*                (X5) = NEW CPU SELECTION LEFT SHIFTED 24 BITS.
*                (X3) = CPU SELECTION MASK LEFT SHIFTED 24 BITS.
*
*         USES   X - 6, 7.
 
 
 SJC      BSS    0           ENTRY
 
*         THE ASSIGNMENT OF CPU 1 IS PROHIBITED IN CASE THE PP ISSUING
*         THE *SJCM* FUNCTION IS ASSIGNED TO A SUBSYSTEM WHILE OTHER
*         PP-S ARE ASSIGNED.  WHEN THE REQUESTING PP DROPS, THE *DPPM*
*         PROCESSOR WILL RESET THE *CWQW* CPU ASSIGNMENT FLAGS FROM THE
*         *JCIW* CPU SELECTION IF NO OTHER ACTIVITY IS PRESENT.
 
 
 SJC      BSS    0           ENTRY
          SX7    1           DISALLOW ASSIGNMENT OF CPU 1
          LX7    24-0
          BX6    X6+X7
          EQ     /MONITOR/SJC3  RETURN TO MAIN *SJCM* PROCESSOR
 BNJ      SPACE  4,15
**        BNJ - EXTENSION TO *BNJ* FOR DUAL CPU MACHINES.
*
*         ENTRY  (X6) = 42 BIT MASK LEFT JUSTIFIED.
*
*         EXIT   TO */MONITOR/BNJ16*.
*                (X3) = *CWQW* OF NEW JOB (DELINKED FROM *WQ*).
*                (A3) = *CWQW* ADDRESS OF NEW JOB.
*                (B4) = PRIORITY WITH FLAGS OF NEW JOB.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 7.
*                B - 3, 4, 5, 6.
*
*         CALLS  /MONITOR/ACS.
 
 
 BNJ      BSS    0           ENTRY
 
*         SEARCH *WQ* FOR JOB THAT CAN USE THIS CPU AND UPDATE *WQ*
*         LINKAGE.
*         SEARCH LOOP REPLICATED FOR PERFORMANCE.
 
          SA1    WQRL        GET *WQ* POINTER
          SB6    A0+59-25    SET THIS CPU SELECTION BIT SHIFT COUNT
 BNJ1     SA3    X1          GET NEXT ENTRY
          LX7    B6,X3
          PL     X7,BNJ2     IF JOB CAN USE THIS CPU
          SA1    X3          GET NEXT ENTRY
          LX7    B6,X1
          NG     X7,BNJ1     IF JOB CANNOT USE THIS CPU
          BX7    -X6*X1      EXTRACT *WQ* LINK
          BX3    X6*X3
          BX7    X3+X7       MERGE LINK IN PREVIOUS ENTRY
          SA7    A3          UPDATE *WQ* LINKAGE
          SA3    A1+         GET SELECTED ENTRY
          EQ     BNJ3        CLEAR *WQ* LINK IN SELECTED ENTRY
 
 BNJ2     BX7    -X6*X3      EXTRACT *WQ* LINK
          BX1    X6*X1
          BX7    X1+X7       MERGE LINK IN PREVIOUS ENTRY
          SA7    A1          UPDATE *WQ* LINKAGE
 BNJ3     UX0,B4 X3          UNPACK PRIORITY
          BX7    X6*X3       CLEAR *WQ* LINK IN SELECTED ENTRY
          ZR     B4,BNJ3     IF NOT VALID *WQ* ENTRY FOR SELECTION
          SA7    A3+
          BX3    X7
          LX7    59-49
          NG     X7,BNJ11    IF ACTIVE CPU SLICE
 
*         SEARCH *WQ* FOR FIRST ENTRY AT OR BELOW PRIORITY OF NEW JOB
*         AND ADVANCE CPU SERVICE CYCLE.
*         SEARCH LOOP REPLICATED FOR PERFORMANCE.
 
          SA1    WQRL        GET *WQ* POINTER
          SX7    3
          SB3    BNJ5        SET *ACS* RETURN ADDRESS
          LX7    48
          BX7    X3+X7       SET PRIORITY FLAGS FOR COMPARISON
          SX5    A3          SET NEW JOB *CWQW* ADDRESS
          UX0,B6 X7          UNPACK PRIORITY WITH FLAGS
 BNJ4     SA4    X1          GET NEXT ENTRY
          UX0,B5 X4          UNPACK *WQ* ENTRY PRIORITY
          LE     B5,B6,/MONITOR/ACS  IF ENTRY .LE. NEW JOB
          SA1    X4          GET NEXT ENTRY
          UX0,B5 X1          UNPACK *WQ* ENTRY PRIORITY
          GT     B5,B6,BNJ4  IF ENTRY .GT. NEW JOB
          SX0    X4
          BX4    X1
          SX1    X0+
          EQ     /MONITOR/ACS  ADVANCE SERVICE CYCLE
 
*         UPDATE SERVICE CYCLE OF JOB IN OTHER CPU IF SAME PRIORITY AS
*         NEW JOB.
 
 BNJ5     SB3    A0-CPAL-1
          SA1    -B3         GET OTHER CPU *CPAL*
          LX1    -24
          SA2    X1+STSW
          LX2    59-56
          MX6    -58
          NG     X2,BNJ6     IF SUB-CP ACTIVE
          LX1    24          SET EXCHANGE PACKAGE ADDRESS
 BNJ6     SA1    X1+CWQW     GET OTHER CPU JOB *CWQW*
          LX6    48-58
          BX1    -X6*X1      CLEAR PRIORITY FLAGS
          UX0    B5,X1       UNPACK PRIORITY OF OTHER CPU JOB
          NE     B5,B6,BNJ7  IF NOT SAME PRIORITY
          SA7    A1+B1       SET SERVICE CYCLE AND CLEAR ACCUMULATORS
          ERRNZ  CSAW-CWQW-1
 
*         DETERMINE IF SETTING CPU SLICE ACTIVE HAS CHANGED THE ORDER
*         OF *WQ*.
 
 BNJ7     LX4    59-49
          PL     X4,BNJ11    IF ALL ENTRIES HAD INACTIVE SLICE
          SA1    WQRL
          SB5    1000B       INITIALIZE PREVIOUS ENTRY PRIORITY
 BNJ8     SX2    A1          SET PREVIOUS ENTRY ADDRESS
          SA1    X1
          SB3    B5          SET PREVIOUS ENTRY PRIORITY
          UX0,B5 X1          UNPACK *WQ* ENTRY PRIORITY
          LT     B5,B6,BNJ11 IF PRIORITY .LT. NEW JOB PRIORITY
          LE     B5,B3,BNJ8  IF ENTRY IN ORDER WITH PREVIOUS
 
*         FIND END OF *WQ* ENTRIES TO MOVE AND DELINK FROM QUEUE.
 
 BNJ9     SX4    A1          SET PREVIOUS ENTRY ADDRESS
          SA1    X1+
          UX0,B3 X1          UNPACK *WQ* ENTRY PRIORITY
          EQ     B3,B5,BNJ9  IF SAME PRIORITY AS PREVIOUS
          SA2    X2
          MX6    42
          BX7    X6*X2       CLEAR OLD LINK
          SX0    A1+
          BX7    X7+X0       MERGE NEW LINK
          SA7    A2+
 
*         FIND POSITION IN *WQ* TO INSERT ENTRIES AND RELINK INTO
*         QUEUE.
 
          SA1    WQRL
 BNJ10    SX7    A1          SET PREVIOUS ENTRY ADDRESS
          SA1    X1+
          UX0,B3 X1          UNPACK *WQ* ENTRY PRIORITY
          LE     B5,B3,BNJ10  IF POSITION NOT FOUND
          SA4    X4          GET LAST ENTRY TO MOVE
          BX2    -X6*X2      ADDRESS OF FIRST ENTRY TO MOVE
          SX0    A1
          SA1    X7
          BX4    X6*X4       CLEAR OLD LINK
          BX7    X4+X0       MERGE NEW LINK
          SA7    A4
          BX7    X6*X1       CLEAR OLD LINK
          BX7    X7+X2       MERGE NEW LINK
          SA7    A1
 
*         SEARCH *WQ* FOR JOB THAT CAN PREEMPT JOB IN OTHER CPU.
*         SEARCH LOOP REPLICATED FOR PERFORMANCE.
 
 BNJ11    SB3    A0-CSWL-1
          SA4    -B3         GET OTHER CPU *CSWL*
          SA2    A4+TSCL-CSWL  GET OTHER CPU *TSCL*
          NG     X4,/MONITOR/BNJ16  IF SWITCH REQUEST FOR OTHER CPU
          SA1    WQRL        GET *WQ* POINTER
          SB6    A0-59+24    SET OTHER CPU SELECTION BIT SHIFT COUNT
          UX0,B3 X2          UNPACK PRIORITY OF JOB IN OTHER CPU
          SB6    -B6         SET SELECTION BIT FOR OTHER CPU
 BNJ12    SA2    X1+         GET NEXT ENTRY
          UX0,B5 X2          UNPACK *WQ* ENTRY PRIORITY
          LX7    B6,X2
          LE     B5,B3,/MONITOR/BNJ16  IF ENTRY .LE. OTHER CPU JOB
          PL     X7,BNJ13    IF JOB CAN USE OTHER CPU
          SA1    X2+         GET NEXT ENTRY
          UX0,B5 X1          UNPACK *WQ* ENTRY PRIORITY
          LX7    B6,X1
          LE     B5,B3,/MONITOR/BNJ16  IF ENTRY .LE. OTHER CPU JOB
          NG     X7,BNJ12    IF JOB CANNOT USE OTHER CPU
 BNJ13    MX7    1
          BX7    X4+X7
          SA7    A4+         REQUEST SWITCH OF OTHER CPU
          EQ     /MONITOR/BNJ16  SET ACTIVE CPU STATUS
 RCC      SPACE  4,30
**        RCC - EXTENSION TO *RCC* FOR DUAL CPU MACHINES.
*
*         ENTRY  (X1) = THIS CPU RECALL SLICE EXPIRATION TIME.
*                (X2) = CURRENT MILLISECOND CLOCK.
*                (X3) = *CWQW* OF RECALLED JOB.
*                (X4) = *CSWL* FOR THIS CPU.
*                (X7) = 24 BIT MASK LEFT JUSTIFIED.
*                (A3) = *CWQW* ADDRESS OF RECALLED JOB.
*                (A4) = ADDRESS OF *CSWL* FOR THIS CPU.
*                (B3) = EXIT ADDRESS.
*                (B4) = RECALLED JOB PRIORITY AND FLAGS.
*                (B5) = THIS CPU JOB PRIORITY AND FLAGS.
*
*         EXIT   TO */MONITOR/RCC12* TO CHECK RECALL SLICE EXPIRATION
*                  FOR THIS CPU.
*                TO */MONITOR/RCC13* TO UPDATE *CWQW* AND REQUEST CPU
*                  SWITCH.
*                TO */MONITOR/RCC14* TO UPDATE *CWQW* AND CLEAR *MTR*
*                  BYPASS FLAG.
*                (X3) = *CWQW* OF RECALLED JOB.
*                (X4) = *CSWL* OF CPU FOR SWITCH REQUEST IF EXIT TO
*                       *RCC13*.
*                (A3) = *CWQW* ADDRESS OF RECALLED JOB.
*                (A4) = *CSWL* ADDRESS OF CPU FOR SWITCH REQUEST IF
*                       EXIT TO *RCC13*.
*                (B3) = EXIT ADDRESS.
*
*         USES   X - 0, 1, 4, 6.
*                B - 6.
*                A - 1, 4.
 
 
 RCC      SB6    A0-59+24    SET OTHER CPU SELECTION BIT SHIFT COUNT
          SB6    -B6
          LX0    X3,B6
          PL     X0,RCC1     IF JOB CAN USE OTHER CPU
          SB6    A0+59-25    SET THIS CPU SELECTION BIT SHIFT COUNT
          LX0    B6,X3
          NO
          NG     X0,/MONITOR/RCC14  IF JOB CANNOT USE THIS CPU
 
*         CHECK PRIORITY OF JOB WITH SELECTION FOR THIS CPU.
 
          GT     B4,B5,/MONITOR/RCC13  IF NEW JOB .GT. THIS CPU JOB
          LT     B4,B5,/MONITOR/RCC14  IF NEW JOB .LT. THIS CPU JOB
          EQ     /MONITOR/RCC12  CHECK RECALL SLICE EXPIRED
 
*         GET PARAMETERS FOR JOB IN OTHER CPU.
 
 RCC1     SB6    A0-TSCL-1
          IX6    X2-X1       CHECK THIS CPU RECALL SLICE EXPIRED
          SA1    -B6         GET OTHER CPU PARAMETERS
          SB6    A0+59-25    SET THIS CPU SELECTION BIT SHIFT COUNT
          LX0    B6,X3
          UX1,B6 X1          GET PRIORITY OF JOB IN OTHER CPU
          BX1    -X7*X1
          IX1    X2-X1       CHECK OTHER CPU RECALL SLICE EXPIRED
          PL     X0,RCC2     IF JOB CAN USE THIS CPU
 
*         CHECK PRIORITY OF JOB WITH SELECTION FOR OTHER CPU.
 
          SA4    A1+CSWL-TSCL
          NG     X4,/MONITOR/RCC14  IF OTHER CPU SWITCH REQUEST PENDING
          GT     B4,B6,/MONITOR/RCC13  IF NEW JOB .GT. OTHER CPU JOB
          LT     B4,B6,/MONITOR/RCC14  IF NEW JOB .LT. OTHER CPU JOB
          NG     X1,/MONITOR/RCC14  IF CPU RECALL SLICE NOT EXPIRED
          EQ     /MONITOR/RCC13  SWITCH OTHER CPU
 
*         CHECK PRIORITY OF JOB WITH NO CPU SELECTION.
 
 RCC2     GT     B4,B5,RCC4  IF NEW JOB .GT. THIS CPU JOB
          GT     B4,B6,RCC5  IF NEW JOB .GT. OTHER CPU JOB
          LT     B4,B5,RCC3  IF NEW JOB .LT. THIS CPU JOB
          PL     X6,/MONITOR/RCC13  IF THIS CPU RECALL SLICE EXPIRED
 RCC3     LT     B4,B6,/MONITOR/RCC14  IF NEW JOB .LT. OTHER CPU JOB
          NG     X1,/MONITOR/RCC14  IF CPU RECALL SLICE NOT EXPIRED
          EQ     RCC5        SWITCH OTHER CPU IF NO CURRENT REQUEST
 
 RCC4     LE     B4,B6,/MONITOR/RCC13  IF NEW JOB .LE. OTHER CPU JOB
          GE     B6,B5,/MONITOR/RCC13  IF OTHER CPU JOB .GE. THIS CPU
 RCC5     SA4    A1+CSWL-TSCL
          NG     X4,/MONITOR/RCC14  IF OTHER CPU SWITCH REQUEST PENDING
          EQ     /MONITOR/RCC13  SWITCH OTHER CPU
 SAX      SPACE  4
**        SAX - SET ALTERNATE CPU EXCHANGE.
*
*         ENTRY  (A5) = OUTPUT REGISTER ADDRESS.
*
*         EXIT   TO PPRX.
*
*         CALLS  SPB.
 
 
 SAX      TB3    A0-1,-CX    SET ALTERNATE CPU
          SX0    B1
          SA1    -B3
          SB3    /MONITOR/PPRX  *SPB* EXIT ADDRESS
          TJP    (/PROBE/ACE,PROBE,/MONITOR/SPB) SET PPU REQUEST BIT
 EXPACS   SPACE  4,10
**        IXP1 - CPU 1 IDLE EXCHANGE PACKAGE.
 
 
 IXP1     EXP    P=2,RA=IDL1,FL=5,MA=IXP1,X1=77777777777777777777B
 
*         *STSW*.
 
          VFD    3/BCPS      *B* CPU STATUS
          VFD    57/0
 
*         *CWQW*.
 
          VFD    2/1
          VFD    7/IDCS      CPU PRIORITY
          VFD    1/0
          VFD    1/1         CPU SLICE ACTIVE
          VFD    1/0         RECALL FLAG
          VFD    1/1         EXTENDED CPU SLICE INCOMPLETE
          VFD    2/0
          VFD    9/0         SERVICE CYCLE
          VFD    9/SSSC*JCBE  SERVICE PARAMETERS INDEX
          VFD    1/0         *MTR* BYPASS FLAG
          VFD    2/2         SELECT CPU 1
          VFD    3/0
          VFD    3/DIXT      DUAL CPU EXCHANGE PACKAGE TYPE
          VFD    18/0        *WQ* LINKAGE
 
*         *CSAW*.
 
          VFD    60/0
 
*         *CTMW*.
 
          VFD    60/0
 
**        IDL1 - CPU 1 IDLE PROGRAM.
 
 
 IDL1     CON    0           (RA) FOR IDLE PROGRAM
          CON    0           (RA+1) FOR IDLE PROGRAM
+         CX2    X1          DELAY (60 BITS)
*         EQ     2           LOOP WITHOUT DELAY (CACHE MACHINE)
          CX2    X1          DELAY (60 BITS)
          EQ     2           LOOP
          SPACE  4
**        SCX1 - SUB-CONTROL POINT EXCHANGE PACKAGE - CPU 1.
*
*         NOTE - THIS EXCHANGE PACKAGE IS ALSO USED FOR THE CODE WHICH
*                INITIATES THE CPU1 IDLE PACKAGE ON A CACHE MACHINE.
*                THE VALUES PRESET FOR *A0* AND *B0* ARE REQUIRED BY
*                MICROCODE ON A DUAL CPU CACHE MACHINE.
 
 
 SCX1     EXP    P=IIP,FL=(,MCM),A0=1,B0=210B
 IIP      SPACE  4,10
**        IIP - INITIATE IDLE PACKAGE FOR DUAL CPU CACHE MACHINE.
*
*         EXIT   (X1) = ZERO (THIS IS REQUIRED BY *STL*).
 
 
 IIP      BSS    0           ENTRY
          SA2    EIBP        SET *MTR* EXCHANGE PACKAGE ADDRESS
          MX7    42
          LX7    32
          BX2    X7*X2
          SX6    /MONITOR/MXP
          LX6    32
          BX6    X2+X6
          SA6    A2
          SB2    IXP1
          XJ     B2          START CPU1 IDLE PACKAGE
          SPACE  4,10
          ENDBLK
          BLOCK  MMF,(MULTI-MAINFRAME PROCESSING ROUTINES.)
 ARM      SPACE  4
**        ARMF - ADVANCE RUNNING TIME AND MULTI-MAINFRAME PROCESSING.
*         *ARMF* IS CALLED ONCE EVERY SECOND BY *MTR* TO DO THE
*         FOLLOWING.
*         1)     STATUS FLAG REGISTER BITS.
*         2)     WRITE REAL TIME CLOCK TO EXTENDED MEMORY.
*         3)     DETERMINE STATUS OF OTHER MAINFRAMES BY INTERROGATING
*                THEIR EXTENDED MEMORY CLOCKS (EVERY 2 SECONDS).
*         4)     CHECK FOR INTER-MAINFRAME MESSAGE REQUEST.
*
*         ENTRY
*T X0     24/,12/  S,6/,18/  ARMF
*                (B7) = S = 0 IF MAINFRAMES TO BE STATUSED.
*         EXITS TO *ART* IF NORMAL PROCESSING.
*         EXITS TO *EPR* IF DOWN MACHINE OR MESSAGE PROCESSING TO BE
*                DONE IN PROGRAM MODE.
 
 
 ARM      TSX2   (402B,ESM,6B)  STATUS FLAG REGISTER
          LX2    21
          SX4    B1
          SX6    TMMF
          LX4    17          POSITION BIT TO STATUS
          LX6    36
          SB3    A0          SAVE CPU NUMBER
          BX0    X2+X4
          SX5    .COMI       CHECK COMMUNICATION PROCESSING
 ARM1     RE     /ECS/FRWC
          BX6    X4+X6
 +        AX4    1
          BX0    X2+X4
          NZ     X4,ARM1     IF MORE BITS TO STATUS
          SA6    EFRL        STORE FLAG REGISTER BITS
          BX5    X5*X6
          TX0    ECCM        EXTENDED MEMORY CLOCK LOCATION
          SA0    PDTL
          SX3    A0
          LX3    30
          BX0    X0+X3
          LX5    58-PMRF-COMI  POSITION PROGRAM MODE REQUEST BIT (PMRF)
          WE     1           WRITE EXTENDED MEMORY CLOCK
          PER    /ECS/ECH1,/ECS/PER  HANG ON UNRECOVERED WRITE ERROR
          NZ     B7,ARM16    IF MAINFRAMES NOT TO BE STATUSED
          TX0    ETLT*100B+SMET,ECLT
          TX0    X0,TCNT
          SA0    MBUF
          SX3    A0+
          LX3    30
          BX0    X0+X3
          SB7    MXMF
 
*         CHECK STATUS OF OTHER MACHINES.
 
          RE     MXMF        READ EXTENDED MEMORY CLOCKS
          PER    /MMF/ARM16,/ECS/PER  PARITY ERROR PROCESSING
 ARM2     ZR     B7,ARM16    IF END OF MACHINES
          SA3    TMMF-1+B7
          SB7    B7-B1
          SB4    X3
          SA1    MBUF+B7     READ CURRENT CLOCK VALUE
          SA2    ARMA+B7     LAST CLOCK VALUE
          BX2    X1-X2
          SX7    B1
          ZR     X2,ARM4     IF CLOCK NOT CHANGING
 
*         PROCESS MACHINE WITH CLOCK CHANGING.
 
          BX6    X1
          SA6    A2          STORE NEW CLOCK VALUE
          EQ     B4,B1,ARM2  IF IN ACTIVE STATE
          SB4    X3-MFDA-1
          PL     B4,ARM2     IF PROCESSING DOWN MACHINE
 
*         SET MACHINE AS CURRENTLY BEING ACTIVE IN *MFST*.
 
          SA0    A3+
          SX3    A3+
          TX0    B7+ETLT*100B+MFET,ECLT
          TX0    X0,TCNT
          LX3    30
          BX0    X0+X3
          RE     1
+         SA3    A0          SET STATE
          MX2    42
          BX3    X2*X3
          BX7    X7+X3
          SA7    A3
          EQ     ARM2        PROCESS NEXT MACHINE
 
*         ADVANCE MACHINE STATE.
 
 ARM3     IX7    X7+X3
          SA7    A3
          EQ     ARM2        PROCESS NEXT MACHINE
 
*         MACHINE CLOCK IS NOT CHANGING.
 
 ARM4     ZR     B4,ARM2     IF DOWN STATE
          EQ     B4,B1,ARM3  IF ACTIVE STATE - ADVANCE TO *MFD1*
          SB4    X3-MFD1
          ZR     B4,ARM3     IF *MFD1* STATE - ADVANCE TO *MFD2*
          EQ     B4,B1,ARM6  IF *MFD2* STATE
          SB4    X3-MFDA
          ZR     B4,ARM7     IF *MFDA* STATE
          NE     B4,B1,ARM2  IF WAITING FOR *1MR* COMPLETE
 
*         *MFCD* - CALL *1MR* TO RELEASE TRACK INTERLOCKS.
 
          SA1    ARMB        SET PP CALL
          SX0    B7
          IX6    X1+X0
          TB7    SCA         SET SYSTEM CONTROL POINT
          PX0    X0,B3       SAVE CPU NUMBER
          SB4    B0          SET LIBRARY SEARCH NEEDED
          SB3    ARM5        SET EXIT ADDRESS
          EQ     /MONITOR/APQ  ASSIGN PP
 
 ARM5     SB7    X0          RESTORE MACHINE INDEX
          UX0,B3 X0
          SX7    B1+
          ZR     X1,ARM2     IF PP NOT ASSIGNED - PROCESS NEXT MACHINE
          SA3    TMMF+B7     RESTORE (X3)
          EQ     ARM3        ADVANCE STATE
 
*         *MFD2* - MACHINE IS DOWN FOR TWO STATUSES.
 
 ARM6     BX1    X3
          LX1    59-46
          PL     X1,ARM3     IF NOT LOW SPEED PORT MACHINE
          MX7    12
          SA1    ARMD        SET MESSAGE
          BX4    X7*X3
          LX4    -18
          BX7    X1+X4
          TA7    MS2W,SCA
          SA1    A1+B1
          BX7    X1
          SA7    A7+B1
          SA1    A1+B1
          LX4    -24
          BX7    X1+X4
          SA7    A7+1
          EQ     ARM2        PROCESS NEXT MACHINE
 
*         *MFDA* - DOWN ACKNOWLEGED STATE PROCESSOR.
 
 ARM7     SA1    ARMC        SET MESSAGE *MACHINE XX DOWN.*
          MX7    12
          BX4    X7*X3
          LX4    12
          BX7    X1+X4
          TA7    MS2W,SCA
          SA1    A1+B1
          BX7    X1
          SA7    A7+B1
          SX4    B1
          LX4    B7
          SX5    B7+B1       SET MACHINE MASK FIELD BEING PROCESSED
          SB4    CIRI
 
**        SET *CIRI* INTERLOCK WHICK CONTROLS THE RELEASEING OF
*         A DOWN MACHINES FLAG REGISTER AND DEVICE INTERLOCKS.
*         IF THE *CIRI* INTERLOCK IS HELD BY THE DOWN MACHINE
*         THE INTERLOCK WILL BE RELEASED AND ANOTHER ATTEMPT
*         WILL BE MADE TO OBTAIN THE INTERLOCK.
 
 ARM8     SB6    ARM9        SET *SFR* RETURN
          EQ     /ECS/SFR    SET *CIRI* FLAG BIT
 
 ARM9     SA0    MBUF
          TX0    ETLT*100B+FRET,ECLT  SET ADDRESS OF FLAG WORDS
          TX0    X0,TCNT
          SX3    A0+
          LX3    30
          BX0    X3+X0
          RE     18
          PER    /MMF/ARM16,/ECS/PER  PARITY ERROR PROCESSING
          TSX0   (402B,ESM,6B)  STATUS FLAG REGISTER
          LX0    21
          BX0    X0+X4
          ZR     X7,ARM11    IF INTERLOCK OBTAINED
 
*         CHECK *CIRI* INTERLOCK HELD BY DOWN MACHINE.
 
          SA2    A0+B4       READ FLAG WORD
          AX2    12
          BX2    X4*X2
          ZR     X2,ARM15    IF HELD BY RUNNING MACHINE
          SB6    ARM8        SET *CFR* RETURN
          EQ     /ECS/CFR    CLEAR *CIRI* INTERLOCK
 
*         CLEAR *TRTI* INTERLOCK IF HELD BY DOWN MACHINE.
 
 ARM10    SX2    X4+.TRTI    CLEAR MACHINE MASK AND *TRTI* FLAG BITS
          TSX0   (403B,ESM,7B)
          LX0    21
          BX0    X0+X2
 ARM11    RE     /ECS/FRWC
          EQ     ARM10       IF *TRTI* HELD BY DOWN MACHINE
          SB4    18
          SB7    -B1         SET FIRST CALL TO *SSD*
          MX7    -12
          SB6    ARM12       SET *CFR* RETURN
          SB5    ARM13       SET *SSD* RETURN
 
*         CLEAR FLAG REGISTER BITS.
 
 ARM12    SB4    B4-B1
          SA0    MBUF
          SA3    A0+B4       READ FLAG WORD
          NG     B4,/PROGRAM/SSD  IF END OF FLAG BITS
          BX3    X3-X5
          BX3    -X7*X3
          ZR     X3,/ECS/CFR  IF INTERLOCK HELD BY DOWN MACHINE
          EQ     ARM12       CLEAR BITS
 
*         CLEAR  DEVICE INTERLOCKS HELD BY DOWN MACHINES.
 
 ARM13    SX2    A0          SET BUFFER ADDRESS
          SX4    X4+SDGL
          LX2    30
          BX0    X2+X4       FORM EXTENDED MEMORY ADDRESS
          MX4    -6
          NG     B7,ARM14    IF END OF SHARED DEVICES
          RE     1
          PER    /PROGRAM/SSD,/ECS/PER  PARITY ERROR PROCESSING
          SA2    A0          READ *SDGL*
          BX7    -X4*X2
          AX7    1
          BX3    X7-X5
          NZ     X3,/PROGRAM/SSD  IF NOT INTERLOCKED BY DOWN MACHINE
          BX7    X4*X2
          SA7    A2          CLEAR INTERLOCK
          WE     1
          PER    /ECS/ECH1,/ECS/PER  HANG ON UNRECOVERED WRITE ERROR
          EQ     /PROGRAM/SSD  SEARCH FOR SHARED DEVICE
 
 ARM14    SB7    X5-1        RESTORE (B7)
          SX0    B1+
          SA3    TMMF+B7     ADVANCE STATE
          IX7    X3+X0
          SA7    A3
 ARM15    SA1    EFRL        RESTORE (X5)
          SX5    .COMI
          BX5    X5*X1
          LX5    58-PMRF-COMI
          SB4    CIRI
          SB6    ARM2
          EQ     /ECS/CFR    CLEAR FLAG BIT AND ADVANCE MACHINE
 
 ARM16    SA0    B3          RESTORE CPU NUMBER
          BX0    X5
          NZ     X5,/MONITOR/EPR  IF PROGRAM MODE PROCESSING TO PERFORM
          EQ     /MONITOR/.ARTF  ADVANCE RUNNING TIME
 
 ARMA     BSS    MXMF        MACHINE CLOCK TEMPORARIES
 
 ARMB     VFD    18/0L1MR,6/0,12/0,6/CDV,18/1
 
 ARMC     CON    10HMACHINE XX-2RXX
          CON    6L DOWN.
 ARMD     CON    10HIF XX DOWN-2RXX*1BS30
          CON    10H ENTER *DO
          CON    10HWN,MID=XX*-2RXX*1BS6
 
 TMMF     BSS    0           MAINFRAME STATE TABLE
          DUP    MXMF,1
          DATA   0
          TITLE  PPU REQUEST PROCESSOR.
 SFI      SPACE  4,15
**        SFI - SET *FATI* INTERLOCK.
*
*         *AFAM* EXTENSION TO SET *FATI* FLAG REGISTER INTERLOCK AND
*         READ *FAT* ENTRY FROM EXTENDED MEMORY.
*
*         ENTRY  (X2) = *FAT* INDEX.
*
*         EXIT   (X1) = GLOBAL COUNT WORD FROM *FAT*.
*                (B3) = CPU NUMBER.
*                TO *REJ*, IF UNABLE TO SET *FATI* INTERLOCK.
*                TO *AFA1*, IF SUCCESSFUL READ OF *FAT* ENTRY.
*                TO *PMR*, IF PARITY ERROR IN READING *FAT*.
 
 
 SFI      TSX0   (400B,ESM,4B)  SELECT
          SX1    .FATI
          LX0    21
          SB3    A0
          BX0    X0+X1
          LX2    FATS        POSITION *FAT* INDEX
          RE     /ECS/FRWC   SET *FATI* INTERLOCK
          EQ     /PROGRAM/REJ
 
*         THIS WORD IS CHANGED BY *AFAM* PRESET.
 
 SFIA     SA0    MBUF        SET CM ADDRESS FOR READ
          TX0    X2+FAST*100B,TCNT  SET FAST ATTACH TABLE ADDRESS
          SX1    A0+
          LX1    30
          BX0    X0+X1
          RE     2+MXMF
          PER    /MMF/SFI1,/ECS/PER  PARITY ERROR PROCESSING
          SA0    A0+B1       ADJUST ADDRESS TO GLOBAL COUNT WORD
          SX1    B1
          IX0    X0+X1
          LX1    30
          IX0    X0+X1
          SA1    A0          READ GLOBAL WORD FROM EXTENDED MEMORY
          EQ     /MONITOR/AFA1  CONTINUE
 
*         PARITY ERROR PROCESSOR.
 
 SFI1     SB6    /PROGRAM/REJ  SET *SFR* RETURN
          SB5    /MONITOR/PPRX  SET *REJ* RETURN
          SB4    COMI        SET PARITY ERROR RECOVERY NEEDED
          JP     /ECS/SFR    SET FLAG BIT
 CFI      SPACE  4,10
**        CFI - CLEAR *FATI* INTERLOCK.
*
*         *AFAM* EXTENSION TO UPDATE LOCAL MACHINE COUNTS, CLEAR
*         *FATI* FLAG REGISTER INTERLOCK AND WRITE *FAT* ENTRY TO
*         EXTENDED MEMORY.
*
*         ENTRY  (XO) = *FAT* ADDRESS IN EXTENDED MEMORY.
*                (X7) = 1/1, 59/0
*                (B3) = CPU NUMBER.
*
*         EXIT   (X7) = 0.
*                TO *ECH*, IF UNRECOVERED WRITE ERROR OR REJECT IN
*                CLEARING FLAG INTERLOCK.
*                TO *AFA6*, IF SUCCESSFUL WRITE OF *FAT* ENTRY.
 
 
 CFI      LX7    1-59        GET NON-ROLLABLE BIT
          BX5    X7*X6
          SA3    B4+         READ LOCAL WORD FROM CM
          TA2    A6,MIN      READ LOCAL WORD FROM ECS
          IX6    X3-X4
          BX3    -X7*X6
          IX6    X3+X5
          SA6    A3
          IX6    X2-X4
 
*         WRITE UPDATED ENTRY BACK TO ECS.
 
          BX2    -X7*X6
          IX6    X2+X5
          BX7    X7-X7
          SA6    A2+         STORE LOCAL WORD TO BE WRITTEN TO ECS
          WE     1+MXMF
          PER    /ECS/ECH1,/ECS/PER  HANG ON UNRECOVERED WRITE ERROR
 
*         RELEASE FLAG REGISTER INTERLOCK.
 
 CFI1     TSX0   (403B,ESM,7B)
          LX0    21
          SX2    .FATI
          BX0    X0+X2       SET FLAG REGISTER FUNCTION
          SA0    B3          RESTORE CPU NUMBER
          RE     /ECS/FRWC   CLEAR *FATI* INTERLOCK
          RJ     /ECS/ECH    HANG ON HALF EXIT
          EQ     /MONITOR/AFA6  RETURN
 AFAP     SPACE  4,10
**        AFAP - *AFAM* PRESET.
*
*         *AFAM* PRESET IS EXECUTED ON THE FIRST *AFAM* CALL.
*         THIS IS REQUIRED SINCE THE *FAT* TRACK IS NOT KNOWN UNTIL
*         AFTER *0MF* HAS EXECUTED TO ALLOCATE IT.
 
 AFAP     MX6    -18         RESET MONITOR MODE ADDRESS
          BX3    X6*X3
          SX6    /MONITOR/.AFAM
          IX6    X6+X3
          MX4    -11
          SA6    TPPR+AFAM-CPUM
          TA3    ALGL,EMS    SET FAST ATTACH TABLE ADDRESS
          SX6    2020B
          TLX6   0,TNSC
          BX4    -X4*X3
          IX6    X6*X4
          SA3    SFIA        READ INSTRUCTION WORD
          IX6    X3+X6
          SA6    A3
          EQ     /MONITOR/.AFAM  ENTER PROCESSOR
          SPACE  4
**        MBUF - SCRATCH BUFFER FOR USE IN MONITOR MODE.
 
 
 MBUF     BSS    18
          TITLE  MMF PROGRAM MODE PROCESSING ROUTINES.
          QUAL   PROGRAM
 CLM      SPACE  4
**        CLM - CHECKPOINT LOCAL MST TO ECS.
*
*         ENTRY  (A3) = MST ADDRESS OF SHARED DEVICE.
*                (B5) = EXIT ADDRESS.
*
*         EXIT   ENTIRE LOCAL AREA OF MST WRITTEN TO ECS.
*
*         USES   X - 0, 4.
*                B - 3.
*                A - 4.
 
 
 CLM      SA4    A3+SDGL     READ ECS ADDRESS OF MST
          SB3    A0          SAVE CPU NUMBER
          AX4    36
 
*         ENTER HERE FROM *CDI*.
 
 CLM0     SA0    A3+GLGL     START OF LOCAL MST
          TX0    X4+GLGL-LLLL,MSL  ECS ADDRESS OF LOCAL AREA
          MX4    -24
          BX0    -X4*X0
          SX4    A0+
          LX4    30
          BX0    X4+X0
          WE     LLLL
          PER    /PROGRAM/CLM1,/ECS/PER  IGNORE UNRECOVERED MRT ERROR
 CLM1     SA0    B3          RESTORE CPU NUMBER
          JP     B5          EXIT
 CDI      SPACE  4,15
**        CDI - CLEAR DEVICE INTERLOCK.
*
*         ENTRY  (X1) = FIRST WORD OF TRT TO UPDATE IN ECS.
*                (X3) = 1.
*                (X4) = ADDRESS OF MST IN ECS.
*                (X5) = LAST WORD + 1 OF TRT TO UPDATE IN ECS.
*                (X6) = SDGL WORD OF MST.
*                (X7) = STATUS TO RETURN O OUTPUT REGISTER.
*                (B4) = TRT LINK WORD TO UPDATE.
*                (B5) = EXIT ADDRESS.
*                (B6) = FIRST WORD ADDRESS OF TRT IN CM.
*                (A4) = ADDRESS OF SDGL WORD OF MST.
*
*         EXIT   (OR) = (X7)
 
 CDI1     MX2    -6          CLEAR DEVICE INTERLOCK
          SB3    A0          SAVE CPU NUMBER
          LX3    6
          BX6    X2*X6
          MX2    -24
          BX4    -X2*X4
          NG     X5,CDI3     IF NO UPDATE OF TRT
          SA0    X1+B6       SET FIRST WORD TO WRITE TO ECS
          IX0    X3+X4
          LT     B4,B6,CDI2  IF NO LINK WORD
          SX2    A0-B4
          NG     X2,CDI2     IF LINK WORD IN UPDATING REGION
          SA0    B4          START UPDATE AT LINK WORD
 CDI2     SX1    A0-B6       FIRST WORD TO UPDATE
          IX5    X5-X1       LAST - FIRST
          IX0    X0+X1
          SB4    X5          SET WORD COUNT
          SX2    A0
          LX2    30
          BX0    X2+X0
          MX2    -10
          BX2    -X2*X5
          SX2    X2-1000B-1
+         PL     X2,*        IF WORD COUNT .GT. 1000
          WE     B4          UPDATE TRT IN ECS
          RJ     /ECS/ECH    HANG ON WRITE ERROR
 CDI3     IX6    X3+X6       SET UP-TO-DATE COPY FOR THIS MACHINE
          SA0    A3
          SA6    A4
          SX6    A0
          LX6    30
          BX0    X4+X6
          WE     SDGL+1
          RJ     /ECS/ECH    HANG ON WRITE ERROR
          SA7    A5          STORE OUTPUT REGISTER
          EQ     CLM0        WRITE LOCAL MST
 SDI      SPACE  4,25
**        SDI - SET DEVICE INTERLOCKED.
*         THE DEVICE INTERLOCK CONTROLS THE UPDATING OF THE TRT AND
*         MST WORDS TDGL, ACGL AND SDGL.
*
*         ENTRY  (X3) = (TDGL).
*                (X4) = ECS ADDRESS OF MST.
*                (X6) = DEVICE INTERLOCK BITS FROM *SDGL*.
*                (B3) = CTR EXIT ADDRESS. NOTE - EXIT IS TO CTR2.
*                (B5) = PRG IF IN PROGRAM MODE.
*                (B6) = 0 IF NO INTERLOCKING TO PERFORM.
*                (B6) .GT. 0 IF TO INTERLOCK AND UPDATE MST/TRT.
*                (A3) = CM ADDRESS OF MST.
*                (A4) = ADDRESS OF *ACGL* WORD IN MST.
*
*         EXIT   (X0) = 12/TRT LENGTH + 2000B, 48/ECS ADDRESS OF MRT.
*                (X5) = -7777B
*                (B4) = TRT LENGTH.
*
*         USES   X - 0, 1, 2, 4, 5, 6, 7.
*                A - 1, 2, 4, 6.
*                B - 3, 4, 5, 6.
*
*         NOTE - (A0) IS SET TO 2 FOR PROGRAM MODE MONITOR.
 
 
 SDI      AX3    24
          MX2    -24
          BX4    -X2*X4
          TSX2   (400B,ESM,4B)
          LX2    21
          BX3    -X5*X3      TRT LENGTH
          MX7    -FRRC       FLAG REGISTER RETRY COUNT
          ZR     B6,SDI8     IF NO READ OF MST/TRT
          SB6    PRG         ZERO IF CALLED FOR PROGRAM MODE
          SX5    A0+         SAVE CPU NUMBER
          SA0    SDIA        ENSURE (A0) .LT. FL FOR FLAG OPERATION
          NZ     X6,SDI10    IF DEVICE INTERLOCKED BY THIS MACHINE
          TX6    .TRTI,MMK
 
*         SET *TRTI* FLAG REGISTER INTERLOCK.
 
 SDI1     LX7    -1          DECREMENT RETRY COUNT
          BX0    X2+X6       SET FLAG REGISTER FUNCTION
          NG     X7,SDI10    IF FAILED TO INTERLOCK FLAG REGISTER
          RE     /ECS/FRWC
          EQ     SDI1        RETRY
 
*         READ MST FROM ECS.
 
          SX0    A0+
          LX0    30
          BX0    X4+X0       SET ADDRESS OF MST IN ECS
          NE     B5,B6,SDI2  IF MONITOR MODE
          SX5    B1+B1       SET (A0) FOR PROGRAM MODE
          RE     SDGL+1      READ MST  (PROGRAM MODE)
          PER    /PROGRAM/SDI11,/PROGRAM/PER  PARITY ERROR PROCESSING
          EQ     SDI3
 
 SDI2     RE     SDGL+1      READ MST  (MONITOR MODE)
          PER    /PROGRAM/SDI9,/ECS/PER  PARITY ERROR PROCESSING
*                            SWITCH REQUEST TO PROGRAM MODE ON ERROR
 
*         CHECK DEVICE INTERLOCK.
 
 SDI3     SA2    SDIA+SDGL
          MX7    -6
          BX4    -X7*X2
          NZ     X4,SDI9     IF MST/TRT INTERLOCK SET
          SA4    A4          READ SDGL WORD FROM CM MST
          BX7    X2-X4
          ZR     X7,SDI7     IF NO UPDATE OF MST/TRT NEEDED
          AX7    36
          BX2    X1
 +        NE     B5,B6,SDI9  IF MONITOR MODE - CANNOT READ TRT
          NZ     X7,*        IF BAD ECS ADDRESS
          SB6    SDI4        *CMP* *MSR* RETURN ADDRESS
          SA0    PBUF        SET CM ADDRESS OF TRANSFER
          SX5    B3          SAVE RETURN ADDRESS
          SB7    X3          TRT LENGTH
          SA1    A3+TRLL     GET FWA OF TRT
          SB3    X1-MECB
          SX3    X0+TRST*100B  START OF TRT IN ECS
          SB3    A0-B3
 
*         TRT READ LOOP.
 
 SDI4     SB4    MECB        MAXIMUM ECS TRANSFER SIZE
          SX1    A0
          LX1    30
          BX0    X3+X1       ECS ADDRESS OF TRT READ
          SB7    B7-B4       DECREMENT WORD COUNT
          SX3    X3+B4       INCREMENT ECS ADDRESS OF TRT
          SB3    B3-B4       INCREMENT FOR *CMP* *MSR*
          PL     B7,SDI5     IF NOT LAST SHORT BLOCK TO READ
          SB4    B7+B4       SET SHORT BLOCK WORD COUNT
          BX1    X2          RESTORE (X1)
          LT     B4,B1,SDI6  IF END OF TRANSFER
 SDI5     RE     B4          READ TRT BLOCK
          PER    /PROGRAM/SDI11,/PROGRAM/PER  PARITY ERROR PROCESSING
          SX0    A0          STARTING ADDRESS OF MOVE
          SX1    B3          DIFFERENCE
          TJP    (/CME/MSR,CME,/PROGRAM/CMP,CMU,/MONITOR/MSR)
 
 SDI6     SB5    PRG         RESET (B5)
          SA2    SDIA+ACGL   COPY MST FROM BUFFER
          SA4    SDIA+SDGL
          BX6    X2
          SA2    A2-B1
          SA6    A3+B1
          ERRNZ  ACGL-1
          SB3    X5          RESTORE RETURN ADDRESS
          LX3    X2
          BX7    X2
          LX3    24
          SX5    B1+B1       SET (A0) TO 2 FOR PROGRAM MODE
          SA7    A3
          AX3    48          SET LENGTH OF TRT
 
*         WRITE INTERLOCKED MST TO ECS.
 
 SDI7     TX6    MIL         SET MST INTERLOCKS
          BX7    X4+X6
          AX4    36
          SA7    A3+SDGL
          MX7    -24
          BX4    -X7*X4
          SX7    A3
          LX7    30
          BX0    X4+X7
          SA0    A3
          WE     SDGL+1
          RJ     /ECS/ECH    HANG ON WRITE ERROR
 
*         CLEAR TRTI INTERLOCK.
 
          TSX2   (402B,ESM,6B)  STATUS FLAG REGISTER TO INSURE SET
          TX6    MMK
          LX2    21
          BX0    X2+X6
          SX6    X6+.TRTI
          RE     /ECS/FRWC   STATUS FLAG BIT  (HALF EXIT EXPECTED)
          SA0    X5          RESTORE CPU NUMBER
          MX5    -12
          PL     X5,*        IF FLAG BIT NOT SET
          TSX2   (403B,ESM,7B)
          LX2    21
          BX0    X2+X6
          RE     /ECS/FRWC   CLEAR FLAG REGISTER INTERLOCK
          RJ     /ECS/ECH    HANG ON HALF EXIT
 SDI8     TX0    1000B,MRT
          SB4    X3
          IX0    X0+X4       SET MRT ADDRESS
          PX0    X0,B4       PACK TRT LENGTH IN (X0)
          EQ     CTR2        RETURN
 
*         CLEAR FLAG REGISTER AND EXIT.
 
 SDI9     TSX0   (403B,ESM,7B)
          LX0    21
          BX0    X0+X6
          RE     /ECS/FRWC   CLEAR FLAG REGISTER INTERLOCK
          RJ     /ECS/ECH    HANG ON HALF EXIT
 SDI10    SA0    X5          RESTORE (A0)
          EQ     B5,B6,REJ   IF PROGRAM MODE - REJECT REQUEST
          SA5    A5
          BX7    X5
          EQ     /MONITOR/PMR  SWITCH REQUEST TO PROGRAM MODE
 
*         PARITY ERROR PROCESSING - EXECUTED ONLY IN PROGRAM MODE.
 
 SDI11    TSX2   (403B,ESM,7B)  CLEAR TRTI INTERLOCK
          TX6    .TRTI,MMK
          LX2    21
          BX0    X2+X6
          SB3    X5          CPU NUMBER FOR *SFR* TO RESTORE
          RE     /ECS/FRWC   CLEAR FLAG BIT
+         SB6    REJ         SET *SFR* RETURN
          SB5    PRG         SET *REJ* RETURN
          SB4    COMI        FLAG BIT TO SET
          EQ     /ECS/SFR    SET BIT TO REQUEST PARITY ERROR PROCESSING
 
 FRRC     EQU    10          FLAG REGISTER RETRY COUNT
 
 SDIA     BSS    SDGL+1      MST READ BUFFER
 SMU      SPACE  4,20
**        SMU - STORE MRT UPDATE.
*
*         THIS ROUTINE IS CALLED WHEN CHANGING AN MRT BIT.  IT WRITES
*         THE CHANGED MRT WORD TO EXTENDED MEMORY.
*
*         ENTRY  (X0) = 12/ TRT LENGTH +2000B, 48/ MRT ADDRESS IN EM.
*                (X4) = CALLER FLAG.
*                     .LT. 0, IF CALLED BY *DTC*.
*                     .EQ. 0, IF CALLED BY *STBM*.
*                     .GT. 0, IF CALLED BY *RTC*.
*                (A3) = MST ADDRESS (*TDGL*).
*                (A6) = MRT WORD.
*                (B3) = MRT FWA.
*
*         EXIT   (X6) = 0.
*                (X1) = FWA OF TRT TO UPDATE, IF *STBM* CALL.
*                (X5) = LWA + 1 OF TRT TO UPDATE, IF *STBM* CALL.
*
*         USES   X - 0, 1, 2, 6.
*                A - 1.
 
 
 SMU      SX1    A6-B3       MRT OFFSET
          UX0    X0
          SX6    A0          SAVE CPU NUMBER
          IX0    X0+X1       ADD MRT OFFSET
          SX1    A6+
          LX1    30
          BX0    X1+X0
          SA0    A6+
          SX1    A2+         SAVE (A2) IF PARITY ERROR
          WE     1           WRITE MRT WORD
          PER    /PROGRAM/SMU1  PARITY ERROR PROCESSOR
 SMU1     SA2    X1          RESTORE (A2)
          SA0    X6+         RESTORE (A0)
          BX6    X6-X6
          NG     X4,DTC5     IF CALLED BY *DTC*
          NZ     X4,RTC13    IF CALLED BY *RTC*
          SX1    A4-B6       SET ONE WORD UPDATE FOR *CDI*
          SX5    X1+B1
          EQ     CCP1        CHECK FOR CHECKPOINT REQUESTED
 SSD      SPACE  4,16
**        SSD - SEARCH FOR SHARED DEVICE.
*
*         ENTRY  (B5) = EXIT ADDRESS.
*                (B7) .LT. 0 IF FIRST CALL TO INITIALIZE SHARED SEARCH.
*                (B7) = LAST SHARED DEVICE FOUND IF NOT INITIAL CALL.
*
*         EXIT   (X3) = TDGL WORD OF MST.
*                (X4) = ECS ADDRESS OF MST/TRT.
*                (B7) = EST ORDINAL OF SHARED DEVICE.
*                (B7) .LT. 0 IF SHARED DEVICE NOT FOUND.
*                (A3) = ADDRESS OF TDGL WORD OF MST.
*                (A4) = ADDRESS OF SDGL WORD OF MST.
*
*         USES   X - 3, 4.
*                B - 7.
*                A - 3, 4.
 
 
 SSD      PL     B7,SSD1     IF NOT INITIAL CALL TO SSD
          TB7    ESTL
 SSD1     SB7    B7-B1
          NG     B7,SSD2     IF END OF EST - SHARED DEVICE NOT FOUND
          SX4    B7
          CX3    X4,EST      CONVERT EST ORDINAL TO OFFSET
          TA3    X3+EQDE,EST READ EST ENTRY
          MX4    -12
          PL     X3,SSD1     IF NOT MASS STORAGE
          BX3    -X4*X3
          LX3    3           MST ADDRESS
          SA4    X3+SDGL
          SA3    X3
          ERRNZ  TDGL
          AX4    36
          ZR     X4,SSD1     IF NOT SHARED DEVICE
          NG     X4,SSD1     IF ISD
 SSD2     JP     B5          RETURN
          TITLE  EXTENDED MEMORY ERROR RECOVERY PROCESSING.
 PMR      SPACE  4,10
**        PMR - PROCESS EXTENDED MEMORY ERROR RECOVERY.
 
 
 PMR      SA1    /ECS/MC     ASSIGN *1MC* TO PROCESS ERROR DATA
          SB3    PMR1        *APS* RETURN ADDRESS
          EQ     APS         ASSIGN *1MC*
 
 PMR1     BX7    X7-X7       INITIALIZE *1MC* BUFFER
          SB3    B0
          SA7    PMRA        CLEAR ERROR ENCOUNTERED
          ZR     X1,DPE      IF *1MC* NOT ASSIGNED ENTER PROCESSOR
          SA7    X1+1
          EQ     DPE         PROCESS MST/TRT PARITY ERRORS
 
*         RELEASE *1MC* UPON COMPLETION OF ERROR RECOVERY.
 
 PMRX     SB4    COMI        CLEAR EM ERROR PROCESSING REQUEST
          ZR     X1,PMR2     IF NO *1MC* BUFFER
          SA1    X1          SET BUFFER COMPLETE
          MX6    1
          BX6    X6+X1
          SA6    A1
 PMR2     SB6    PRG         *CFR* EXIT ADDRESS
          SA1    PMRA
          ZR     X1,/ECS/CFR IF NO ERRORS LEFT, CLEAR FLAG BIT
          EQ     PRG         EXIT
 
 PMRA     CON    0
 DPE      SPACE  4,10
**        DPE - SHARED DEVICE ERROR PROCESSING.
*
*         THIS ROUTINE SCANS ALL SHARED DEVICES CHECKING TO SEE IF
*         THE UP-TO-DATE COPY OF THE MST/TRT ARE HELD BY THIS MACHINE.
*         IF THEY ARE THE CM TABLES ARE COMPARED WITH THE EXTENDED
*         MEMORY COPY.  ANY DIFFERENCES ARE REPORTED VIA *1MC* AND THE
*         CORRECT DATA IS WRITTEN TO EXTENDED MEMORY.
*
*         ENTRY  (X1) = *1MC* BUFFER ADDRESS.
*                TRTI FLAG BIT SET.
 
 
 DPE      SB6    DPE1        *SFR* RETURN ADDRESS
          SB4    TRTI
          JP     /ECS/SFR    SET *TRTI* FLAG BIT
 
 DPE1     NZ     X7,PMRX     IF UNABLE TO SET INTERLOCK
          SB7    -1          INITIALIZE DEVICE SEARCH
          SB5    DPE2        SET *SSD* RETURN
          EQ     SSD         SEARCH FOR SHARED DEVICE
 
 DPE2     NG     B7,DPE7     IF END OF SHARED DEVICES
          SA0    PBUF        READ *SDGL* WORD
          SX0    X4+SDGL
          SX7    A0
          LX7    30
          SA4    A4
          BX0    X0+X7
          AX3    24
          MX6    -12
          RE     1
          EQ     DPE6        ERROR IN READING *SDGL*
 
*         PROCESS TRT ERRORS.
 
+         SA2    A3+TRLL     SET FWA OF TRT
          SB6    X2
          BX3    -X6*X3
          SB4    B6+X3       SET LWA OF TRT
          SA2    A0
          IX2    X2-X4       COMPARE *SDGL* WORDS
          AX4    36
          NZ     X2,DPE5     IF NOT UP-TO-DATE TABLES FOR THIS DEVICE
          SX0    X4+TRST*100B  SET TRT ADDRESS FOR THIS MACHINE
          SB5    DPE3        *DRE* RETURN ADDRESS
          JP     DRE1        DETECT ERROR IN TRT
 
*         PROCESS MST ERRORS.
 
 DPE3     SX0    X4
          SB6    A3          FWA OF MST
          SB4    A3+GLGL     LWA+1 OF MST TO BE PROCESSED
          SB5    DPE4        *DRE* RETURN ADDRESS
          EQ     DRE1        PROCESS MST ERRORS
 
*         SET CHECKPOINT BIT.
 
 DPE4     SX6    B1
          SB5    DPE2        SET *SSD* RETURN
          LX6    50
+         SA2    A3+STLL     **** PERFORM IN ONE WORD ****
          BX6    X6+X2       **** PERFORM IN ONE WORD ****
          SA6    A2          **** PERFORM IN ONE WORD ****
          JP     SSD         CHECK NEXT DEVICE
 
*         CHECK FOR ERROR IN MST/TRT.
 
 DPE5     BX0    X4+X7       SET MST ADDRESS
          RE     SDGL
          SA6    PMRA        NOTE ERROR IN MST READ
+         SX2    TRST*100B   ADVANCE TO TRT
          IX0    X0+X2
          RE     MECB        READ FIRST PART OF TRT
          SA6    PMRA        NOTE ERROR IN TRT READ
          SX2    MECB
          IX0    X0+X2
          RE     MECB        READ SECOND PART OF TRT
          SA6    PMRA        NOTE ERROR IN TRT READ
+         EQ     SSD         SEARCH FOR NEXT SHARED DEVICE
 
 DPE6     SA6    PMRA        SET ERROR ENCOUNTERED
          EQ     SSD         SEARCH FOR NEXT SHARED DEVICE
 
 DPE7     SB6    FPE         *CFR* RETURN ADDRESS
          SB4    TRTI
          JP     /ECS/CFR    CLEAR *TRTI* FLAG BIT
 FPE      SPACE  4
**        FPE - FAST ATTACH TRACK PARITY ERROR PROCESSING.
*
*         THIS ROUTINE RECOVERS FROM PARITY ERRORS IN THE FAT BY
*         REGENERATING THE DATA FOR GLOBAL FAST ATTACH FILES.
*         EACH MACHINE MUST PERFORM THE REGENERATION, SINCE THE
*         LOCAL COUNT WORD OF THE FAT IS KNOWN ONLY TO INDIVIDUAL
*         MACHINES.
 
 
 FPE      SB6    FPE1        *SFR* RETURN ADDRESS
          SB4    FATI
          JP     /ECS/SFR    SET *FATI* FLAG BIT
 
 FPE1     NZ     X7,PMRX     IF UNABLE TO INTERLOCK
          TA3    -FNTE,FNT   INITIALIZE SYSTEM FNT SEARCH
 
*         SEARCH FNT FOR GLOBAL FAST ATTACH ENTRY.
 
 FPE2     TX6    A3+FNTE,-FNTLWA
          SA3    A3+FNTE     GET NEXT FNT ENTRY
          ZR     X6,FPE10    IF END OF FNT
          MX4    -6
          AX3    6
          BX2    -X4*X3      FILE TYPE
          SB4    X2-FAFT
          AX3    6
          NZ     B4,FPE2     IF NOT FAST ATTACH FILE
          BX7    -X4*X3
          LX7    FATS
          ZR     X7,FPE2     IF NO FAT INDEX
 
*         READ FAT ENTRY TO CHECK FOR ERRORS.
 
          TA2    ALGL,EMS    COMPUTE FAT ADDRESS
          MX0    -11
          BX2    -X0*X2
          ZR     X2,FPE10    IF FAT TRACK NOT YET ALLOCATED
          SX6    2020B       PRESERVE LINKAGE WITHIN TRACK
          TLX6   0,TNSC
          IX0    X6*X2
          IX0    X0+X7       ADD FAT INDEX
          TX0    X0+FAST*100B,TCNT
          SA0    PBUF
          SX2    A0
          LX2    30
          BX0    X0+X2
          BX6    X4*X3
          RE     2+MXMF
          SA6    PMRA        NOTE ERROR IN READ
 
*         PROCESS FILE NAME WORD OF FAT.
 
+         LX6    12
          SA6    A0          STORE CORRECT FILE NAME
          SA0    A0+1        SET SCRATCH CELL ADDRESS
          SX5    -B1         INITIALIZE MACHINE INDEX
          SB6    A6          FWA OF BUFFER TO COMPARE
          SB4    B6+B1       LWA OF BUFFER TO COMPARE
          SB5    FPE3        *DRE* RETURN ADDRESS
          EQ     DRE1        DETECT ERRORS IN FILE NAME
 
*         PROCESS LOCAL COUNT WORDS.
 
 FPE3     SX6    B1          ADVANCE FAT ADDRESS
          IX0    X0+X6
 FPE4     SX5    X5+1
          SX3    X5-MXMF
          PL     X3,FPE6     IF END OF LOCAL COUNT WORDS
          SA2    /MMF/TMMF+X5  READ MACHINE STATE
          BX6    X6-X6
          SX2    X2
          ZR     X2,FPE5     IF MACHINE NOT PRESENT
          TX3    X5+1,-MIN
          NZ     X3,FPE3     IF NOT THIS MACHINE
          SA2    A3+B1       GET FST ENTRY
          ERRNZ  FSTG-FNTG-1 CODE DEPENDS ON VALUE
          MX3    -36
          BX6    -X3*X2      FORM ENTRY FOR THIS MACHINE
          TX4    MID         MERGE MACHINE ID IN ENTRY
          LX4    -12
          BX6    X6+X4
 FPE5     SA6    PBUF
          SB6    A6          FWA TO CHECK
          SB4    A6+B1       LWA + 1 TO CHECK
          SB5    FPE4        *DRE* RETURN ADDRESS
          EQ     DRE1        CHECK LOCAL COUNT WORD
 
*         CHECK FAMILY NAME WORD.
 
 FPE6     SA2    A3+B1
          LX2    12
          MX4    -9
          BX3    -X4*X2      EST ORDINAL
          CX4    X3,EST      CONVERT EST ORDINAL TO OFFSET
          TA4    X4+EQDE,EST READ EST ENTRY
          MX3    -12
          BX4    -X3*X4
          SB5    FPE7        *DRE* RETURN ADDRESS
          LX4    3
          SA4    X4+PFGL
          BX6    X3*X4
          SA6    PBUF        STORE FAMILY NAME + DEVICE NUMBER
          SB6    A6          FWA TO CHECK
          SB4    A6+B1       LWA + 1 TO CHECK
          EQ     DRE1        CHECK FAMILY NAME WORD
 
 FPE7     SX4    B1          ACCUMULATE GLOBAL COUNTS
          SA2    A3+B1       READ FST
          MX6    12
          LX6    -12
          BX6    X6*X2       EXTRACT FIRST TRACK
          MX3    -36
          IX0    X0-X4
          MX5    MXMF
 FPE8     IX0    X0-X4
          PL     X5,FPE9     IF END OF LOCAL WORDS
          LX5    1
          RE     1
          EQ     FPE2        QUIT ON ERROR
          SA2    A0+
          BX2    -X3*X2
          IX6    X6+X2
          EQ     FPE8        LOOP
 
 FPE9     SA6    PBUF        STORE COMPUTED ENTRY
          SB6    A6          FWA TO CHECK
          SB4    A6+B1       LWA + 1 TO CHECK
          SB5    FPE2        *DRE* RETURN ADDRESS
          EQ     DRE1        CHECK GLOBAL COUNT WORD
 
*         CLEAR FAT ENTRY AND EXIT.
 
 FPE10    SB6    PMRX        *CFR* RETURN ADDRESS
          SB4    FATI
          JP     /ECS/CFR    CLEAR FLAG BIT
          TITLE  SUBROUTINES.
 DRE      SPACE  4
**        DRE - DETECT / REPORT AND RECOVER EXTENDED MEMORY ERRORS.
*
*         ENTRY  (X0) = FWA OF ECS WORDS TO CHECK.
*                (X1) = COMMUNICATION BUFFER ADDRESS.
*                (B4) = LWA OF CM BUFFER TO COMPARE WITH ECS.
*                (B5) = EXIT ADDRESS.
*                (B6) = FWA OF CM BUFFER TO COMPARE WITH ECS.
*                (A0) = SCRATCH WORD FOR EXTENDED MEMORY READ.
 
 
 DRE      SB3    B0          REPORTED INDEX
          ZR     X1,DRE1     IF NO BUFFER ASSIGNED
          BX7    X7-X7       INITIALIZE BUFFER
          SA7    X1+1
 DRE1     SA2    B6+         READ GOOD DATA
          MX7    -24
          BX0    -X7*X0
          SX7    A0+
          LX7    30
          BX0    X7+X0
          BX6    X2          GOOD DATA
          SX3    701B        UNRECOVERED WITH GOOD AND BAD DATA
          RE     1
          EQ     DRE2        IF ERROR DETECTED
          SX3    301B        RECOVERED WITH GOOD AND BAD DATA
          SA2    A0+         READ POSSIBLE BAD DATA
          BX2    X2-X6
          CX2    X2
          ZR     X2,DRE3     IF DATA VERIFIES
 DRE2     MX7    -24
          BX0    -X7*X0      ECS ADDRESS
          SX7    B6          CM ADDRESS OF GOOD DATA
          LX7    30
          BX0    X7+X0
          SX7    A0          SAVE (A0)
          SA0    B6+         ADDRESS OF GOOD DATA
          WE     1           RESTORE GOOD DATA
          PER    /ECS/ECH1   HANG ON UNRECOVERED WRITE ERROR
          SA0    X7+         RESTORE (A0)
          ZR     X1,DRE3     IF NO BUFFER ASSIGNED
          GT     B3,B1,DRE3  IF TWO ERRORS REPORTED
          SB3    B3+B1       INCREMENT ERROR INDEX
          SA2    X7          BAD DATA
          LX3    -18         STATUS
          LX7    24          CM ADDRESS
          BX7    X7+X3
          MX3    -24
          BX0    -X3*X0      ECS ADDRESS
          BX7    X7+X0
          SA7    A7
          BX7    X2
          SA7    A7+B1       BAD DATA
          SA6    A7+B1       GOOD DATA
          BX7    X7-X7
          SA7    A6+B1
 DRE3     SX6    B1+         ADVANCE ADDRESSES
          SB6    B6+B1
          IX0    X0+X6
          LT     B6,B4,DRE1  IF NOT END OF WORDS TO CHECK
          JP     B5          RETURN
 STE      SPACE  4
**        STE - ECS SYSTEM TABLE ERROR.
*
*         ENTRY  (B5) = EXIT ADDRESS IF ENTERED AT STE1.
*
*         EXIT   NONE.
*
*         USES   X - 1, 6.
*                B - NONE.
*                A - 1, 6.
 
 
 STE      SB5    PRG         SET EXIT ADDRESS
 
 STE1     SX1    STEM        *SYSTEM ECS TABLE ERROR.*
          JP     /MONITOR/MSC  SEND MESSAGE TO SYSTEM CONTROL POINT
 
 STEM     DATA   C*SYSTEM ECS TABLE ERROR.*
 
          ENDBLK
          BLOCK  LSPMMF,(MULTI-MAINFRAME VIA LOW SPEED PORT TO EM.)
 AFA      SPACE  4,10
**        AFA - PASS *AFAM* FUNCTION TO *MTE*.
*
*         ENTRY  (A2) = FNT ADDRESS, FNT IS NOT BUSY.
*                (A5) = OUTPUT REGISTER ADDRESS.
 
 
 AFA      SA2    A2          SET FILE BUSY
          SX6    B1
          BX6    X2+X6
          SA6    A2
          EQ     QPR         QUEUE PP REQUEST TO *MTE*
 CDI      SPACE  4,20
**        CDI - CLEAR DEVICE INTERLOCK.
*
*         CHECK FOR ALL QUEUED DEVICE REQUESTS BEING COMPLETE, AND
*         REQUEST *MTE* TO WRITE THE MST/TRT/MRT TO EXTENDED MEMORY.
*
*         ENTRY  (X1) = FIRST WORD OF TRT TO UPDATE.
*                (X5) = LAST WORD + 1 OF TRT TO UPDATE.
*                (X6) = *SDGL* MST WORD WITH BIT 0 CLEARED.
*                (X7) = WORD TO BE STORED IN OUTPUT REGISTER.
*                (B4) = TRT LINK WORD TO UPDATE.
*                (B5) = EXIT ADDRESS.
*                (B6) = START OF TRT.
*                (A3) = ADDRESS OF MST IN CM.
*                (A5) = OUTPUT REGISTER ADDRESS.
 
 
 CDI      BSS    0           ENTRY
          BX2    X2-X2
          NG     X5,CDI3     IF NO UPDATE OF TRT TO EXTENDED MEMORY
 
*         SET FIRST WORD OF TRT TO WRITE TO EXTENDED MEMORY.
 
          SB4    B4-B6
          SB6    X1
          NG     B4,CDI2     IF NO LINK WORD
          SB3    X5
          GE     B4,B6,CDI1  IF LINK WORD IS NOT FIRST WORD TO WRITE
          SX1    B4+         SET FIRST WORD
 CDI1     GE     B3,B4,CDI2  IF LINK WORD IS NOT LAST WORD TO WRITE
          SX5    B4+1
 
*         UPDATE LAST WORD OF TRT TO WRITE TO EXTENDED MEMORY.
 
 CDI2     LX5    36
          LX1    48
          BX2    X5+X1
 CDI3     MX1    1           SET PROGRAM MODE BIT IN OUTPUT REGISTER
          LX1    -1
          BX7    X7+X1
          SA7    A5
 
*         CLEAR MST/TRT CURRENT FLAG AND REQUEST *CDIF* OF *MTE*.
 
          SA4    A3+MCLL     READ *MCLL*
          LX4    47-35       POSITION MRT WRITE FLAG
          SX1    B1
          LX1    47-0
          BX4    X1*X4
          BX2    X2+X4
          SX1    A5          ADD OUTPUT REGISTER ADDRESS
          LX1    24
          BX2    X1+X2
          MX7    54          CLEAR MST/TRT CURRENT IN CM
          BX6    X7*X6
          SA6    A3+SDGL
          SX0    A3+         SET MST ADDRESS
          SX6    CDIF        CLEAR DEVICE INTERLOCK FUNCTION FOR *MTE*
          LX0    12-3
          BX2    X2+X6       MERGE *MCLL* INFORMATION
          BX6    X0+X2
          SB4    B5          SAVE RETURN ADDRESS
          SB5    CDI4        *QPR* RETURN ADDRESS
          EQ     QPR3        QUEUE REQUEST
 
 CDI4     SX7    B0+         CLEAR *MCLL*
          SA7    A3+MCLL
          JP     B4          RETURN
 CME      SPACE  4,15
**        CME - CHECK FOR *MTE* DEVICE INTERLOCK REQUEST NEEDED.
*
*         THIS ROUTINE IS CALLED BY MST/TRT MANIPULATION FUNCTIONS
*         WHICH EXECUTE IN PROGRAM MODE.  IF THE REQUEST IS FOR A
*         LSPMMF DEVICE AND THE MST/TRT NEED TO BE INTERLOCKED IN
*         EM, THEN THE FUNCTION IS QUEUED TO *MTE* FOR PROCESSING.
*         IF THE MST/TRT ARE INTERLOCKED IN EM, THEN THE FUNCTION IS
*         PASSED TO PROGRAM MODE TO EXECUTION.  THIS AVOIDS GOING TO
*         PROGRAM MODE TO PASS REQUESTS TO *MTE*.
 
 
*         ENTRY FOR *VMSM*.
 
 CME0     SX3    X1
          AX3    12
          NZ     X3,/MONITOR/PMR  IF NOT SUBFUNCTION *VEIS*
          ERRNZ  VEIS        CODE DEPENDS ON VALUE
 
*         ENTRY FOR *DLKM* AND *RTCM*.
 
 CME      LX1    24          POSITION EQUIPMENT FIELD
          MX3    -9
          BX3    -X3*X1      EST ORDINAL
          CX4    X3,EST      CONVERT EST ORDINAL TO OFFSET
          TA4    X4+EQDE,EST READ EST ENTRY
          LX4    59-57
          PL     X4,/MONITOR/PMR  IF NOT SHARED
          LX4    -59+57
          MX6    -5
          TX0    X3,-ESTL
          MX3    -12
          BX3    -X3*X4      MST ADDRESS / 10B
          BX0    X4*X0
          LX3    3
          PL     X0,/MONITOR/HNG1  IF NOT MASS STORAGE OR OUT OF EST
          SA4    X3+SDGL     CHECK SHARED STATUS
          AX4    1
          BX6    -X6*X4
          NZ     X6,/MONITOR/PMR  IF INTERLOCKED IN EXTENDED MEMORY
          ZR     X4,/MONITOR/PMR  IF NO EXTENDED MEMORY ADDRESS PRESENT
 
*         ENTRY FOR *DTKM* (QUEUE *MTE* REQUEST).
 
 CME1     TX2    A5-1,-FP    COMPUTE PP REQUEST BIT
          SX3    B1
          AX2    3
          SB6    X2
          LX6    X3,B6
          SB5    /MONITOR/PPRX  SET RETURN ADDRESS
          SX2    A4+MCLL-SDGL
 
*         SET INTERLOCK BIT FOR THIS PP IF NO REQUESTS PENDING.
 
+         SA2    X2                       **** PERFORM IN ONE WORD ****
          NZ     X2,/PROGRAM/REJ  IF SET  **** PERFORM IN ONE WORD ****
          SA6    A2                       **** PERFORM IN ONE WORD ****
          EQ     QPR2        PASS REQUEST TO *MTE*
 ECS      SPACE  4,10
**        ECS - *ECSM* EXTENSION FOR LOW SPEED PORT MMF MODE.
*
*         *ECSM* SUBFUNCTIONS ARE PROCESSED EITHER BY *CPUMTR* OR BY
*         *MTE* AS SHOWN BY THE FOLLOWING TABLE.
*
*         *MTE*  *CPUMTR*
*
*                  RRES        READ RELATIVE USER EXTENDED MEMORY
*                  WRES        WRITE RELATIVE USER EXTENDED MEMORY
*          RECS                READ SYSTEM EM (LINK DEVICE).
*          WECS                WRITE SYSTEM EM (LINK DEVICE).
*          SFRS                SET FLAG REGISTER BIT (LINK DEVICE).
*          CFRS                CLEAR FLAG REGISTER BIT (LINK DEVICE).
*          PELS                PROCESS EM LIST FUNCTION ABSOLUTE.
*                  PELS        PROCESS EM LIST FUNCTION RELATIVE.
*                              BIT 20 OF OR INDICATES RELATIVE LIST.
 
 
 ECS      MX2    -24
          BX2    -X2*X1
          AX2    21
          SB3    X2
          LE     B3,B1,/ECS/ECS  IF READ/WRITE RELATIVE EM
          SB4    PELS
          LT     B3,B4,QPR   IF LINK DEVICE FUNCTION - PASS TO *MTE*
          NE     B3,B4,/ECS/ECS  IF INVALID FUNCTION
          LX1    59-19
          PL     X1,QPR      IF NOT RELATIVE ADDRESS LIST
          LX1    19-59
          EQ     /ECS/ECS    PROCESS RELATIVE LIST
 SDI      SPACE  4,10
**        SDI - SET DEVICE INTERLOCK.
*
*         ENTRY  (X3) = *TDGL* WORD OF MST.
*                (X5) = -7777B.
*                (X6) = INTERLOCK FIELD (LOWER 6 BITS) OF *SDGL*.
*                (B5) = EXIT ADDRESS, IF NEED TO READ MST/TRT.
*                (B6) = 0, IF NOT TO INTERLOCK MST/TRT.
*                (A4) = ADDRESS OF *SDGL* WORD OF MST.
*
*         EXIT   (B4) = TRT LENGTH.
 
 
 SDI      LX3    24
          SX0    B1
          LX0    58
          BX0    X0+X3
          LX3    12          SET TRT LENGTH
          BX3    -X5*X3
          SB4    X3
          ZR     B6,/PROGRAM/CTR2  IF NOT TO INTERLOCK DEVICE
          TX2    A5-1,-FP    COMPUTE PP REQUEST BIT
          SX3    B1
          AX2    3
          SB6    X2
          LX6    X3,B6
          SX2    A4+MCLL-SDGL
 
*         SET INTERLOCK BIT FOR THIS PP IF NO REQUEST PENDING.
 
+         SA2    X2                  **** PERFORM IN ONE WORD ****
          NZ     X2,SDI1     IF SET  **** PERFORM IN ONE WORD ****
          SA6    A2                  **** PERFORM IN ONE WORD ****
          EQ     SDI2        REREAD *SDGL*
 
 SDI1     BX2    X6-X2
          NZ     X2,/PROGRAM/REJ  IF INTERLOCK OWNED BY ANOTHER PP
 SDI2     SA4    A4          REREAD MST/TRT CURRENT FLAG
          MX7    -6
          BX7    -X7*X4
          LX7    59-0
          NG     X7,/PROGRAM/REJ  IF INTERLOCK SET
          ZR     X7,QPR1     IF MST/TRT NOT VALID IN CM
 
*         SET MST INTERLOCK.
 
+         SA4    A4          **** PERFORM IN ONE WORD ****
          BX6    X3+X4       **** PERFORM IN ONE WORD ****
          SA6    A4          **** PERFORM IN ONE WORD ****
          BX6    X6-X4
          NZ     X6,/PROGRAM/CTR2  IF INTERLOCK OBTAINED
          EQ     /PROGRAM/REJ  REJECT REQUEST
 QPR      SPACE  4,15
**        QPR - QUEUE PP REQUEST TO *MTE*.
*
*         THIS ROUTINE PASSES REQUESTS TO *MTE* FOR PROCESSING.
*
*         NOTE - THIS ROUTINE MUST BE INTERRUPTABLE ON EACH WORD
*         BOUNDARY SINCE IT MAY BE ENTERED FROM BOTH MONITOR AND
*         PROGRAM MODE.
*
*         ENTRY  (A5) = PP OUTPUT REGISTER ADDRESS.
*                (B5) = EXIT ADDRESS, IF ENTERED AT *QPR1*.
*                (X6) = 36/,12/  PM,12/  FN, IF ENTERED AT *QPR3*.
*                       PM = FUNCTION PARAMETER.
*                            OUTPUT REGISTER ADDRESS FOR *SDIF*/*AFAF*.
*                            MST ADDRESS / 10B FOR *CDIF*.
*                       FN = *MTE* FUNCTION CODE.
 
 
 QPR      SB5    /MONITOR/PPRX  SET RETURN ADDRESS
          EQ     QPR2        SKIP CLEARING PROGRAM MODE BIT
 
 QPR1     SA5    A5          CLEAR PROGRAM MODE
          MX7    5
          BX7    -X7*X5
          SA7    A5
 QPR2     SX6    A5          SET FUNCTION FOR *MTE*
          R=     X1,PPRF
          LX6    12
          BX6    X6+X1
 
*         ENTER HERE IF (B5) SET AND NOT TO CLEAR PROGRAM MODE BIT.
 
 QPR3     SX1    QE
          SX5    77B
          ERRNZ  MXQP-100B   CODE DEPENDS ON LENGTH OF TABLE
+         SA1    X1          **** PERFORM IN ONE WORD ****
          IX7    X1+X5       **** PERFORM IN ONE WORD ****
          BX7    X5*X7       **** PERFORM IN ONE WORD ****
          SA7    A1          **** PERFORM IN ONE WORD ****
          SA6    MTET+X1
          JP     B5          RETURN
 VMS      SPACE  4,15
**        VMS - VALIDATE MASS STORAGE.
*
*         WHEN *VMSM* DETERMINES THAT A DEVICE VALIDATION ERROR EXISTS
*         IT LEAVES THE DEVICE INTERLOCKED.  IT MUST NOT LEAVE THE
*         PP MASK BIT SET IN *MCLL*.  THIS BIT BEING SET WOULD PREVENT
*         THE MST/TRT FROM BEING WRITTEN BACK TO EXTENDED MEMORY WHEN
*         *DSD* ISSUES A *VMSM* IN RESPONSE TO A *VALIDATE* COMMAND.
*
*         ENTRY  (A3) = ADDRESS OF *TDGL* MST WORD.
*
*         EXIT   TO /PROGRAM/PRG.
 
 
 VMS      SA2    A3+MCLL-TDGL  CLEAR BITS FOR ALL PP-S
          MX6    -20
          BX6    X6*X2
          SA6    A2
          EQ     /PROGRAM/CSM1  CHECK FOR STORAGE MOVE
 TMMF     SPACE  4,10
 TMMF     BSS    0           MAINFRAME STATE TABLE
          DUP    MXMF,1
          DATA   0
 MTET     BSS    0           PP REQUEST LIST
          DUP    MXQP,1
          DATA   0
 QE       CON    MXQP-1      END OF QUEUE POINTER (PP NUMBER)
 MTIN     DATA   0           SHARED DEVICE REQUEST QUEUE *IN* POINTER
 MTOT     DATA   0           SHARED DEVICE REQUEST QUEUE *OUT* POINTER
 MTBT     BSS    0           SHARED DEVICE REQUEST QUEUE
          DUP    MXQP,1
          DATA   0
 SMU      SPACE  4,25
**        SMU - FLAG MRT UPDATE TO *MTE*.
*
*         THIS ROUTINE IS CALLED WHEN CHANGING AN MRT BIT.  IT SETS
*         THE MRT UPDATED FLAG IN *MCLL* WHICH CAUSES *MTE* TO WRITE
*         THE MRT TO EXTENDED MEMORY.
*
*         ENTRY  (X0) = 12/ TRT LENGTH +2000B, 48/ MRT ADDRESS IN EM.
*                (X4) = CALLER FLAG.
*                     .LT. 0, IF CALLED BY *DTC*.
*                     .EQ. 0, IF CALLED BY *STBM*.
*                     .GT. 0, IF CALLED BY *RTC*.
*                (A3) = MST ADDRESS (*TDGL*).
*                (A6) = MRT WORD.
*                (B3) = MRT FWA.
*
*         EXIT   (X6) = 0.
*                (X1) = FWA OF TRT TO UPDATE, IF *STBM* CALL.
*                (X5) = LWA + 1 OF TRT TO UPDATE, IF *STBM* CALL.
*
*         USES   X - 1, 6.
*                A - 1, 6.
 
 
 SMU      SA1    A3+MCLL-TDGL  UPDATE *MCLL*
          SX6    B1
          LX6    35
          BX6    X1+X6
          SA6    A1+
          BX6    X6-X6
          NG     X4,/PROGRAM/DTC5  IF CALLED BY *DTC*
          NZ     X4,/PROGRAM/RTC13  IF CALLED BY *RTC*
          SX1    A4-B6       SET ONE WORD UPDATE FOR *CDI*
          SX5    X1+B1
          EQ     /PROGRAM/CCP1  CHECK FOR CHECKPOINT REQUESTED
 
          ENDBLK
          BLOCK  ISD,(INDEPENDENT SHARED DEVICE PROCESSING.)
 CHR      SPACE  4,40
**        CHR - CHECK FOR HELPER PP REQUIRED.
*
*         *CHR* WILL EXIT TO A FUNCTION PROCESSOR, REJECT THE FUNCTION,
*         QUEUE IT, OR ISSUE A *BOTM* FUNCTION TO INITIATE A HELPER,
*         DEPENDING ON THE DEVICE STATUS AND THE REQUEST.
*
*         - IF THE DEVICE IS NOT ISHARED OR THE CENTRAL MEMORY COPY OF
*           THE TABLES ARE CURRENT, THE FUNCTION WILL BE PROCESSED.
*
*         - IF THE DEVICE IS NOT REMOVABLE, IS INACCESSIBLE, AND THE
*           FUNCTION BEING PROCESSED IS *DTKM*, THE *DTKM* FUNCTION
*           WILL BE QUEUED FOR LATER PROCESSING AND FUNCTION COMPLETE
*           STATUS WILL BE RETURNED TO THE CALLER.
*
*         - IF THE DEVICE IS INACCESSIBLE, THE FUNCTION BEING PROCESSED
*           CANNOT BE QUEUED FOR LATER PROCESSING (NOT *DTKM* OR *DTKM*
*           ON A REMOVABLE DEVICE), AND RETURN ON INACCESSIBLE IS
*           SELECTED, THE INACCESSIBLE STATUS WILL BE RETURNED TO THE
*           CALLER.
*
*         - IF *1RU* IS ACTIVE AND OTHER FUNCTIONS ARE PENDING, THE
*           REQUEST WILL BE QUEUED.
*
*         - IF *1RU* IS ACTIVE AND NO OTHER FUNCTIONS ARE PENDING, THE
*           FUNCTION WILL BE REJECTED.
*
*         ENTRY  (X5) = REQUEST.
*
*         EXIT   (X1) = UNPACKED REQUEST.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6.
*                B - 3, 4, 5 (SEE NOTE).
*
*         NOTE - *B5* IS ONLY USED WHEN A FUNCTION IS REJECTED.
*                OTHERWISE, IT MUST BE PRESERVED AS AN ENTRY CONDITION
*                FOR *CTR1*.
 
 
 CHR      BSS    0           ENTRY
          SA3    CHRA        GET FUNCTION INDEX
          UX1,B4 X5          GET THE FUNCTION NUMBER
          MX6    -9
          LX1    -36         GET THE EST ORDINAL
          SB4    B4+1777B-CPUM
          BX6    -X6*X1
          AX3    B4
          CX7    X6,EST      CONVERT EST ORDINAL TO OFFSET
          TX6    X6,-ESTL
          TA4    X7+EQDE,EST
          CX3    X3
          MX7    -12
          SB4    X3+
          SA3    A3-B4       GET FUNCTION PARAMETERS
          SX0    1
          LX0    56-0
          BX0    X0*X4       REMOVABLE DEVICE FLAG
          LX0    58-56
          BX3    -X0*X3      CLEAR *DTKM* FLAG IF REMOVABLE DEVICE
          BX7    -X7*X4      GET THE MST ADDRESS
          BX6    X6*X4
          LX4    59-52
          LX7    3
          NG     X4,CHR2     IF *ISHARED* DEVICE
 CHR1     SB4    X3          GET FUNCTION PROCESSOR ADDRESS
          UX1    X5          RESTORE PARAMETERS
          JP     B4          PROCESS THE REQUEST
 
 CHR2     PL     X6,CHR13    IF NOT MASS STORAGE OR OUT OF EST
          SA2    X7+STLL     GET PROHIBIT TRT UPDATE BIT
          SA4    X7+SDGL     GET TABLES-CURRENT BIT
          LX2    59-LPTU
          BX6    X3*X2       *1RU* HELPER .AND. PROHIBIT TRT UPDATE
          SA2    X7+DALL     GET SUSPECT BIT
          NG     X6,CHR1     IF *1RU* NOT NEEDED
          LX2    59-55
          LX1    59-45+36
          NG     X2,CHR10    IF DEVICE IS SUSPECT
 
*         INITIATE PP HELPER PROGRAM.
 
 CHR3     AX3    30          POSITION *BOTM* PARAMETERS
          SX1    B1
          SA2    A2+MCLL-DALL
          PL     X3,CHR8     IF HELPER IS NOT *1RU*
          TX7    A5-1+10B,-FP  GET PP BIT
          SX6    A2
          AX7    3
          SA6    CHRB
          SA3    A3          RESTORE PROCESSOR ADDRESS
          SB4    X7
          MX7    12+1        GET OR ADDRESS AND LONG-TERM INTERLOCK
          LX1    B4
          BX7    X7*X2
          BX6    X2+X1       SET REQUEST-IN-PROGRESS
          LX1    21
          BX6    -X1*X6      CLEAR SET-REISSUE
          NZ     X7,CHR9     IF *1RU* ACTIVE OR *SDIS* IN EFFECT
          SX2    B1          SET LATENCY ACTIVITY BIT
          AX5    36          GET EST ORDINAL
          BX6    X6+X2
          SX2    3R1RU       BUILD *1RU* CALL
          SA6    A2
          MX6    -9
          SB3    CHR4        *APQ* RETURN ADDRESS
          BX6    -X6*X5
          LX2    -18
          SB4    -B1         RETURN IF UNASSIGNABLE
          TB7    0,SCA
          BX6    X2+X6
          EQ     /MONITOR/APQ  ATTEMPT TO ASSIGN *1RU*
 
 CHR4     SA2    CHRB        GET *MCLL* ADDRESS
          SX3    /MONITOR/LA1RU*100B+/MONITOR/LA1BP  SET *BOTM* PARAMS
          SA2    X2
          ZR     X1,CHR6     IF NOT ASSIGNED
          SX1    X1+B1       GET *1RU-S* OUTPUT REGISTER ADDRESS
          TX7    A5-1+22*10B,-FP  GET CALLER-S BIT
          LX1    48
          AX7    3
          BX6    X2+X1
          SX1    B1
          SB4    X7
          LX1    B4
 CHR5     SA5    A5          SET STORAGE MOVABLE BIT
          MX7    1
          BX6    X6+X1       SET SET-REISSUE
          LX7    56-59
          SA6    A2
          BX7    X5+X7
          JP     PPR1        LEAVE REQUEST PENDING
 
 CHR6     SX7    A5          SET PP OUTPUT REGISTER ADDRESS
          SB5    CHR7        *IBF* REJECT RETURN ADDRESS
          LX7    48
          BX6    X2+X7
          SA6    A2
          JP     /MONITOR/IBF  ISSUE *BOTM* FUNCTION
 
 CHR7     SA1    CHRB        GET *MCLL* ADDRESS
          SA1    X1          GET *MCLL*
          MX2    22+12
          LX2    22          CLEAR REQUESTS-IN-PROGRESS/LATENCY BITS
          BX6    -X2*X1
          SA6    A1+
          EQ     PPRX        EXIT
 
 CHR8     SB5    PPRX        SET *IBF* REJECT RETURN ADDRESS
          EQ     /MONITOR/IBF  ISSUE *BOTM* FUNCTION
 
 CHR9     SA4    A2+SDGL-MCLL  GET TABLES-CURRENT BIT
          MX7    -42         GET ACTIVITY BITS
          BX7    -X7*X2
          ZR     X7,CHR12    IF TABLES ARE BEING REWRITTEN
          LX4    59-58
          SA6    A2          SET REQUEST IN PROGRESS BIT
          PL     X4,CHR5     IF TABLES ARE NOT CURRENT
          EQ     CHR1        PROCESS REQUEST
 
*         CHECK CALLER FOR ACCESSIBILITY TO SUSPECT DEVICE.
 
 CHR10    TX4    A5-1,-FP
          LX4    PPXES-PPCES
          LX7    X3,B1       POSITION *DTKM* BIT
          TA4    X4+ACPP,FPX
          MX6    -36
          SB7    X4          CP ADDRESS
          NG     X7,QDT      IF *DTKM* FUNCTION
          SA4    B7+JCIW     GET SUBSYSTEM ID
          BX6    -X6*X4
          SA4    B7+SEPW     GET *UTL=* BIT
          SX2    X2+B1       CHECK FOR *DOWN* STATE
          AX6    24
          LX2    59-2
          SX6    X6-LSSI-1
          LX4    59-56
          BX7    -X6+X4
          SA4    A2+SDGL-DALL
          NG     X2,CHR11    IF DEVICE IS DOWN
          NG     X7,CHR3     IF SUBSYSTEM OR *UTL=* ENTRY POINT IS SET
 CHR11    NG     X1,CHR14    IF RETURN-ON-INACCESSIBLE REQUESTED
          SB5    CHR12
          SX6    B1          PRESERVE PROGRAM/MONITOR MODE INTERLOCK
          BX7    X5          RESTORE REQUEST
          EQ     /ISD/CDI    CLEAR *MCLL* BITS AND RETURN
 
 CHR12    SB5    PPRX        SET *REJ* RETURN ADDRESS
          EQ     /PROGRAM/REJ  REJECT REQUEST
 
 CHR13    SB5    PPRX        SET *HNG* RETURN ADDRESS
          EQ     HNG1        HANG PP
 
 CHR14    SA3    /MONITOR/TFPL-1+/MONITOR/LA3RX  GET *3RX* PLD POINTER
          SX6    B1          PRESERVE PROGRAM/MONITOR MODE INTERLOCK
          SB5    B0          SET DIRECT RETURN FROM *CDI*
          SB4    X3+         *3RX* PLD ADDRESS
          SB3    CHR15       SET *CDI* RETURN ADDRESS
          NZ     B4,/ISD/CDI IF PLD NOT BEING MODIFIED
          EQ     CHR12       REJECT REQUEST
 
 CHR15    SA5    A5+         GET ORIGINAL OUTPUT REGISTER
          MX6    1
          BX7    X6*X7
          BX7    X6-X7       SET *MSD* SUBSYSTEM STATUS
          SB3    PPRX        SET *EFP* RETURN ADDRESS
          UX5    X5          SET OUTPUT REGISTER PARAMETERS
          EQ     /MONITOR/EFP  CALL *3RX* AND EXIT
 CHR      SPACE  4,10
**        IFT - ISHARED FUNCTION TABLE GENERATOR.
*
*         *IFT* DEFINES THE FUNCTION PROCESSOR, PP HELPER, AND
*         BOOTSTRAP PROGRAM FOR EACH ISHARED FUNCTION.  IT ALSO BUILDS
*         A MICRO WHICH WILL CREATE A BIT MAP OF THE ISHARED FUNCTIONS.
*
* FUNC    IFT    BOOT,HELPER,PROCR
*
*         ENTRY  *BOOT* = BOOTSTRAP PROGRAM NAME.
*                *HELPER* = HELPER PP NAME.
*                *PROCR* = *CPUMTR* PROCESSOR FOR FUNCTION.
 
 
          PURGMAC  IFT
 
          MACRO  IFT,FUNC,BOOT,HELPER,PROCR
 P        ERRPL  .1-FUNC     FUNCTIONS MUST BE IN ASCENDING ORDER
 P        ERRNG  LA1RU-LA_HELPER  ASSUMED BY *PROHIBIT TRT UPDATE* TEST
          LOC    FUNC
 .1       SET    FUNC
 .A       IFC    EQ,$HELPER$1RU$
 .B       IFC    EQ,$FUNC$DTKM$
          VFD    1/1,1/1,10/,6/0,6/LA_HELPER,6/LA_BOOT,1/1,11/,18/PROCR
 .B       ELSE
          VFD    1/1,1/0,10/,6/0,6/LA_HELPER,6/LA_BOOT,1/1,11/,18/PROCR
 .B       ENDIF
 .A       ELSE
          VFD    1/0,11/,6/0,6/LA_HELPER,6/LA_BOOT,1/0,11/,18/PROCR
 .A       ENDIF
          LOC    *O
 .1       DECMIC FUNC-CPUM
 .M       MICRO  1,,$1S".1"+".M"$
 IFT      ENDM
 
          QUAL   MONITOR
 .M       MICRO  0,,
 .1       SET    0
 
 
**        TABLE OF ISHARED MONITOR FUNCTIONS.
*
*T        1/R, 1/D, 10/ ,18/ *IBF* PARAMETERS ,1/R, 11/ ,18/ PROCESSOR.
*
*         R      1 = HELPER PP IS *1RU*.
*         D      1 = FUNCTION IS *DTKM*.
 
 
 AFAM     IFT    1BP,1FA,.AFAM
 DLKM     IFT    1BP,1RU,PMR
 DTKM     IFT    1BP,1RU,.DTKM
 RTCM     IFT    1BP,1RU,PMR
 STBM     IFT    1BP,1RU,/PROGRAM/CTR1
 VMSM     IFT    1BP,1RU,PMR
          QUAL   *
 
 CHRA     CON    ".M"        ISHARED FUNCTION BIT MAP
 
 CHRB     CON    **          CURRENT MST *MCLL* ADDRESS
 AMM      SPACE  4,10
**        AMM - ACTIVATE MONITOR MODE (PROGRAM MODE).
*
*         ENTRY  (X0) = PP REQUEST.
*                (B3) = EXIT ADDRESS.
*
*         USES   X - 6.
*                A - 6.
 
 
          QUAL   PROGRAM
 AMM      SX6    -2          SET *MTR*-LIKE REQUEST TO MONITOR MODE
          SA6    PX
 
          MJ                 EXCHANGE TO MONITOR MODE
 
          JP     B3          RETURN
          QUAL   *
 CDI      SPACE  4,35
**        CDI - CLEAR DEVICE INTERLOCK EXTENSION FOR ISHARED DEVICES.
*
*         *CDI* CLEARS THE PP-S REQUEST-IN-PROGRESS AND SET-REISSUE-BIT
*         BITS.  IF THE REQUEST ORIGINATED FROM THE PP THAT IS RUNNING
*         *1RU*, *CDI* ALSO CLEARS THE LATENCY ACTIVITY BIT.  IF ALL
*         THE ACTIVITY BITS IN *MCLL* ARE CLEARED, *CDI* CLEARS THE
*         TABLES-CURRENT FLAG IN *SDGL*.  SINCE CLEARING TABLES-CURRENT
*         CAN BE DONE IN MONITOR MODE, WITH OR WITHOUT THE *CPUMTR*
*         INTERLOCK SET, AND CAN ALSO BE DONE IN PROGRAM MODE, INSURING
*         THE INTEGRITY OF *SDGL* REQUIRES RESTRICTIONS ON THE CHANGES
*         THAT CAN BE MADE TO *SDGL* FROM THE TIME IT IS FETCHED BY
*         *CDI* IN THE *PROGRAM* BLOCK AND STORED BY *CDI* IN THE *ISD*
*         BLOCK.
*         THE CODE AT *CDI2* ASSUMES THAT THE ONLY CHANGES THAT WILL BE
*         MADE ARE THE CLEARING OF BITS, NAMELY THE *CPUMTR* INTERLOCK
*         AND THE TABLES-CURRENT BITS.
*
*         ENTRY  (A4) = *SDGL* ADDRESS.
*                (A5) = OUTPUT REGISTER ADDRESS.
*                (X6) = BIT 0 OF *SDGL* MASK.
*                       0, IF CLEARING PROGRAM/MONITOR MODE INTERLOCK.
*                       1, IF PRESERVING INTERLOCK.
*                (X7) = OUTPUT REGISTER IF TO EXIT TO *CSM*.
*                (B5) = *CSM* RETURN ADDRESS IF .NE. 0.
*                (B3) = RETURN ADDRESS IF (B5) .EQ. 0.
*
*         EXIT   TO *CSM* IF (B5) .NE. 0 ON ENTRY.
*                TO (B3) RETURN ADDRESS IF (B5) .EQ. 0 ON ENTRY.
*
*         USES   X - 1, 2, 3, 4, 5, 6.
*                A - 3, 4, 6.
*                B - 6.
 
 
 CDI      BSS    0
          SA3    A4+MCLL-SDGL  CLEAR ACTIVITY BITS
          TX2    A5-1+10B,-FP  GET PP BIT
          MX5    59          SAVE PROGRAM/MONITOR MODE INTERLOCK
          AX2    3
          BX4    X5+X6
          MX1    12          CHECK FOR CALL FROM *1RU*
          BX1    X1*X3
          SB6    X2+
          LX1    12
          SX3    A5
          LX2    X5,B6
          BX3    X1-X3
          LX6    X5,B6       CLEAR SET-REISSUE
          LX2    21
          NZ     X3,CDI1     IF NOT FROM *1RU*
          BX6    X6*X5       CLEAR LATENCY ACTIVITY BIT
 CDI1     BX6    X6*X2       CLEAR REQUEST-IN-PROGRESS
          MX2    -42
          LX5    6
+         SA3    A3          **** PERFORM IN ONE WORD ****
          BX6    X6*X3       **** PERFORM IN ONE WORD ****
          SA6    A3          **** PERFORM IN ONE WORD ****
          SA3    A4          **** PERFORM IN ONE WORD ****
          BX2    -X2*X6      CHECK FOR NO OUTSTANDING FUNCTIONS
          BX6    X4
          LX4    X3,B1       CHECK TABLES CURRENT
          SX3    B0          MST/TRT UPDATE COUNTER INCREMENT
          PL     X4,CDI2     IF TABLES ARE NOT CURRENT
          ZR     X1,CDI2     IF *1RU* IS NOT ACTIVE
          NZ     X2,CDI2     IF FUNCTIONS REMAIN
          PX6    X6          CLEAR TABLES CURRENT BIT
          BX3    -X5         INCREMENT MST/TRT UPDATE COUNTER
 CDI2     SA4    A4          **** PERFORM IN ONE WORD ****
          BX6    X6*X4       **** PERFORM IN ONE WORD ****
          IX6    X6+X3       **** PERFORM IN ONE WORD ****
          SA6    A4          **** PERFORM IN ONE WORD ****
          NZ     B5,/PROGRAM/CSM1  IF EXIT VIA *CSM*
          JP     B3          RETURN
 CTR      SPACE  4,10
**        CTR - *CTR* ISHARED PROCESSING.
 
 
 CTR3     BX0    X3          SET TRT LENGTH
          AX0    24
          BX0    -X5*X0
          SB4    X0
          BX0    X0-X0
          PX0    X0,B4
          ZR     B6,/PROGRAM/CTR2  IF NO INTERLOCK
          EQ     /PROGRAM/CTR1.1  INTERLOCK MST
 MNR      SPACE  4,10
**        *MNR* EXTENSION FOR ISHARED PROCESSING.
*
*         PROCESS *MTR*-LIKE FUNCTION.
*
*         ENTRY  (X3) = MONITOR MODE START TIME.
 
 
 MNR5     NE     B3,B1,/MONITOR/MNR5  IF NOT *MTR*-LIKE REQUEST
          SA1    B2+10B      GET CALLER-S *X0* REGISTER
          BX5    X3          SET MONITOR MODE START TIME FOR *PMN*
          BX0    X1
          SA1    X1+
          SB3    X0-MXPF
          NG     B3,/MONITOR/PMN1  IF NOT PP REQUEST
          MX7    -7-48       CLEAR PROGRAM MODE BIT
          BX7    -X7*X1
          SA7    A1+
          EQ     /MONITOR/PMN4  PROCESS PP FUNCTION
 QDT      SPACE  4,25
**        QDT - QUEUE DROPPABLE TRACKS.
*
*         *QDT* COMPLETES *DTKM* REQUESTS BY PLACING THEM IN A QUEUE
*         WHEN THE FOLLOWING CONDITIONS ARE MET.
*                - THE PP ISSUING THE FUNCTION IS ASSIGNED TO A JOB.
*                - THE JOB IS NOT BEING STORAGE MOVED.
*                - THE *DTKM* IS NOT SETTING *EOI*.
*                - THE QUEUE IN THE JOB-S NFL IS NOT FULL.
*
*         ENTRY  (A2) = ADDRESS OF *DALL* WORD IN THE MST.
*                (A3) = ADDRESS OF FUNCTION PARAMETERS.
*                (X1) = LOWER 48 BITS OF *OR* WITH BIT 45 MOVED TO 59.
*                (X3) = FUNCTION PARAMETERS.
*                (X5) = OUTPUT REGISTER.
*                (B7) = CONTROL POINT AREA ADDRESS.
*
*         EXIT   TO *CHR10* WITH *DTKM* BIT CLEARED, IF REQUEST CANNOT
*                  BE QUEUED.
*                TO *CHR12* TO REJECT REQUEST IF CONTROL POINT BEING
*                  MOVED.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6.
*                B - 3, 4, 6, 7.
 
 
 QDT      BSS    0           ENTRY
          SA4    SMRL
          SX6    B7+
          LX6    -7          CP NUMBER
          MX7    -12
          BX6    X4-X6
          BX6    -X7*X6
          ZR     X6,CHR12    IF CONTROL POINT MOVING
          SA4    B7+FLSW     GET RA AND NFL
          TX6    B7,-SCA
          ZR     X6,QDT3     IF SYSTEM CONTROL POINT
          BX7    X5          CHECK REQUEST
          MX6    -36
          ZR     B7,QDT3     IF SYSTEM CONTROL POINT
          LX7    59-35
          BX6    -X6*X4      GET RA/100
          PL     X7,QDT3     IF SET *EOI* REQUEST
          SX7    QFBN
          AX4    48          GET NFL
          AX6    12
          ZR     X4,QDT3     IF INSUFFICIENT NFL
          LX6    6           RA
          IX7    X6-X7       ABSOLUTE ADDRESS OF *QFBN* QUEUE
          SX6    -QFBL
 QDT1     SX6    X6+B1       SEARCH FOR EMPTY ENTRY
          IX4    X7-X6
          ERX4   X4
          BX3    X4-X5
          NZ     X4,QDT2     IF ENTRY NOT AVAILABLE
          SB7    X6-1        SAVE ORDINAL OF AVAILABLE ENTRY
 QDT2     LX3    0-45        IGNORE THE REQUEST FLAGS
          AX3    3
          ZR     X3,QDT3     IF REQUEST IS ALREADY IN THE TABLE
          NG     X6,QDT1     IF MORE ENTRIES TO CHECK
          NG     B7,QDT4     IF ENTRY IS AVAILABLE
 QDT3     SA3    A3          RESTORE FUNCTION PARAMETERS
          MX6    -59         CLEAR *DTKM* BIT
          LX6    58-59
          BX3    -X6*X3
          EQ     CHR10       REQUEST CANNOT BE QUEUED
 
 QDT4     SX4    B7+B1       SET REQUEST IN *QFBN* QUEUE
          BX6    X5
          IX4    X7-X4
          EWX6   X4
 
*         COMPUTE NUMBER OF SECTORS DROPPED.
 
          SA2    A2+TRLL-DALL  SET TRT BASE ADDRESS
          MX6    12
          LX1    24-59+45    POSITION FIRST TRACK
          MX7    -2
          SB6    B0          PRESET TRACK COUNT
          SB3    X2-4000B/4  PRESET TRT FWA
 QDT5     BX0    X6*X1       EXTRACT LINK
          LX0    10
          SB6    B6+B1
          SA1    B3+X0       READ TRT WORD
          LX0    2
          BX2    -X7*X0      EXTRACT BYTE
          LX2    2           BYTE * 4
          LX3    X2,B1       BYTE * 8
          IX2    X3+X2       BYTE * 12
          SB4    X2+
          LX1    X1,B4       POSITION TRACK BYTE
          NG     X1,QDT5     IF NOT END OF TRACK CHAIN
          SA2    A2+MDGL-TRLL  GET SECTORS PER TRACK
          SX3    B6-B1       NUMBER OF FULL TRACKS
          SA4    A2+SDGL-MDGL  SET *SDGL* ADDRESS
          MX7    -12
          AX1    48          SECTORS IN LAST TRACK
          BX2    -X7*X2
          SX6    1           SET TO PRESERVE INTERLOCK
          IX3    X3*X2
          SB5    PPR1        SET EXIT ADDRESS
          IX7    X3+X1
          EQ     CDI         CLEAR PP ACTIVITY BITS
 RTC      SPACE  4,10
**        RTC - RTCM ISD PROCESSING.
 
 
*         SET INTERMEDIATE RESPONSE FOR ISHARED DEVICE.
 
 RTC      SX3    B4
          CX4    X3,EST      CONVERT EST ORDINAL TO OFFSET
          TA4    X4+EQDE,EST READ EST ENTRY
          LX4    59-52
          PL     X4,/PROGRAM/CTR  IF NOT ISHARED DEVICE
          SX0    A5          REISSUE FUNCTION
          SB3    /PROGRAM/PRG  RETURN ADDRESS
          EQ     /PROGRAM/AMM  ACTIVATE MONITOR MODE
 SMD      SPACE  4,10
**        SMD - SMDM ISHARED PROCESSING.
 
*         CTCS - CLEAR TABLES-CURRENT FLAG
 
          SUBFUN SMDM,(CTCS,C1AS)
          SX7    X2-CTCS
          SA2    A3+MCLL-TDGL
          ZR     X7,SMD1     IF *CTCS*
          MX6    -48         CLEAR *1RU* OUTPUT REGISTER ADDRESS
          BX6    -X6*X2
          SA6    A2+
 SMD1     SA4    A4          GET *SDGL*
          SX6    B1          PRESERVE PROGRAM/MONITOR MODE INTERLOCK
          EQ     /ISD/CDI    CLEAR WAITING FOR LATENCY
 SMU      SPACE  4,25
**        SMU - SET MRT-UPDATED FLAG.
*
*         *SMU* SETS THE TRT- AND MRT-UPDATED FLAGS IN *SDGL*.  THIS
*         CAUSES *1RU* TO WRITE THE TRT AND MRT TO THE DEVICE.  *SMU*
*         ALSO COPIES THE (MST/RT UPDATE COUNTER + 1) FROM *SDGL* TO
*         THIS MAINFRAME-S *DIT* ENTRY.
*
*         ENTRY  (X0) = 12/ TRT LENGTH +2000B, 48/ 0.
*                (X4) = CALLER FLAG.
*                     .LT. 0, IF CALLED BY *DTC*.
*                     .EQ. 0, IF CALLED BY *STBM*.
*                     .GT. 0, IF CALLED BY *RTC*.
*                (A3) = MST ADDRESS (*TDGL*).
*                (B3) = MRT FWA.
*
*         EXIT   (X6) = 0.
*
*         USES   X - 0, 1, 6.
*                A - 1, 6.
*                B - 3.
 
 
 SMU      MX6    2           SET TRT- AND MRT-UPDATE FLAGS
          LX0    12          POSITION TRT LENGTH
          LX6    -2
+         SA1    A3+SDGL-TDGL  **** PERFORM IN ONE WORD ****
          BX6    X1+X6         **** PERFORM IN ONE WORD ****
          SA6    A1            **** PERFORM IN ONE WORD ****
 
*         SET THE UPDATE COUNTER IN THE *DIT*.
 
          SA1    A3+DULL-TDGL  GET MAINFRAME INDEX
          SX0    X0-2000B+7  GET MRT LENGTH
          AX6    6           POSITION THE MST/TRT UPDATE COUNTER
          AX0    3
          SB3    B3+X0       FWA OF DIT
          SX0    B1
          IX6    X6+X0
          MX0    -4
          LX1    -24
          BX1    -X0*X1      MAINFRAME INDEX - 1
          SA1    X1+B3       DIT ENTRY FOR THIS MAINFRAME
          MX0    -30
          BX6    -X0*X6
          LX1    -18
          BX1    X0*X1       CLEAR THE OLD COUNTER VALUE
          BX6    X1+X6
          LX6    18
          SA6    A1
          SX6    B0+
          NG     X4,/PROGRAM/DTC5  IF CALLED BY *DTC*
          NZ     X4,/PROGRAM/RTC13  IF CALLED BY *RTC*
          EQ     /PROGRAM/CCP1  CHECK FOR CHECKPOINT REQUESTED
 STB      SPACE  4,15
**        STB - STBM ISHARED PROCESSING.
 
 
 
*         SET THE LONG-TERM DEVICE INTERLOCK IN *MCLL*.
*
*         ENTRY  (A3) = MST ADDRESS (*TDGL*).
*
*         EXIT   (X6) = 1.
*                TO */ISD/CDI*.
*
*         USES   X - 2, 6, 7.
*                A - 2, 6.
 
 STB2     SA2    A3+MCLL-TDGL  SET LONG-TERM INTERLOCK
          SX6    B1
          MX7    -42         GET ACTIVITY BITS
          LX6    47-0
          BX7    -X7*X2
          BX6    X6+X2
          CX7    X7
          AX7    1
          ZR     X7,STB3.1   IF NO OTHER REQUESTS ARE PENDING
          SA4    A4          CLEAR THE MST/TRT INTERLOCK
          MX6    59
          BX6    X6*X4
          SA6    A4+
          EQ     /PROGRAM/REJ  REJECT REQUEST
 
 STB3     SA2    A3+MCLL-TDGL  SET LONG-TERM INTERLOCK
          SA1    B2+17B      GET ORIGINAL RESPONSE FROM PROGRAM MODE XP
          SX6    B1
          LX6    47-0
          BX6    X6+X2
          BX7    X1
 STB3.1   SA6    A2
          SX6    B1          PRESERVE MST/TRT INTERLOCK
          EQ     /ISD/CDI    EXIT
 
*         CLEAR THE LONG-TERM DEVICE INTERLOCK IN *MCLL*.
*
*         ENTRY  (A3) = MST ADDRESS (*TDGL*).
*
*         EXIT   TO *CHR*.
*
*         USES   X - 2, 5, 6.
*                A - 2, 5, 6.
*                B - 3.
 
 STB4     SA2    A3+MCLL-TDGL  CLEAR LONG-TERM INTERLOCK
          SX6    B1
          SA5    A5          RESTORE INPUT REGISTER
          LX6    47-0
          SB6    B0          DO NOT GET INTERLOCK
          BX6    -X6*X2
          SA6    A2
          SB3    STB5        SET *CTR* EXIT ADDRESS
          EQ     CHR         INITIATE *1RU*
 
 STB5     UX4,B3 X0          SET *SMU* EXIT FLAG
          SB3    B6+B3       *MRT* FWA
          EQ     SMU         SET MRT UPDATE FLAG
 VMS      SPACE  4,10
**        VMS - *VMSM* EXTENSION FOR *ISHARED* DEVICES.
*
*         *VMS* DECIDES WHETHER *1RU* NEEDS TO BE CALLED FOR THIS
*         SUBFUNCTION.
 
 
 VMS      SX3    X5          GET SUBFUNTION
          AX3    12
          NZ     X3,/MONITOR/PMR  IF *1RU* IS NOT REQUIRED
          ERRNZ  VEIS        CODE ASSUMES VALUE
          EQ     CHR         CHECK FOR HELPER REQUIRED
 
 
*         SET/CLEAR LONG-TERM INTERLOCK IN *MCLL*.
 
*         ENTRY  (X3) = 1, IF (X7) = 0.
*                (X7) = RESPONSE.
*                (A3) = ADDRESS OF MST WORD *TDGL*.
*                (A5) = OUTPUT REGISTER ADDRESS.
*                (B5) = RETURN ADDRESS.
 
 VMS1     SA4    A3+SDGL-TDGL
          PL     X4,VMS3     IF NOT AN ISHARED DEVICE
          SA2    A5          GET THE ORGINAL FUNCTION
          SX4    X2          GET THE SUBFUNCTION
          AX2    36          GET THE EST ORDINAL
          AX4    12
          SX2    X2+STBM*1S12-VMSM*1S12  CHANGE FUNCTION CODE TO *STBM*
          SX6    SLTS        SET LONG-TERM INTERLOCK
          LX2    24
          BX6    X2+X6
          NZ     X7,VMS2     IF VALIDATION ERRORS
          BX4    X4-X3
          ERRNZ  VEQS-1      CODE ASSUMES VALUE
          NZ     X4,/PROGRAM/CDI  IF NOT *VEQS* SUBFUNCTION
          IX6    X6+X3       CLEAR DEVICE INTERLOCK
          ERRNZ  SLTS+1-CDIS CODE ASSUMES VALUE
 VMS2     LX6    12
          SA6    A5
          SX0    A5          ISSUE *STBM*
          SB3    B5          RETURN ADDRESS
          EQ     /PROGRAM/AMM  ACTIVATE MONITOR MODE
 
 VMS3     NZ     X7,/PROGRAM/CSM1  IF VALIDATION ERRORS
          EQ     /PROGRAM/CDI  CLEAR DEVICE INTERLOCK
          SPACE  4,10
**        DEFINE TAGS FROM MAIN BLOCK.
 
 HNG      EQU    /MONITOR/HNG
 HNG1     EQU    /MONITOR/HNG1
 PPRX     EQU    /MONITOR/PPRX
 PPR1     EQU    /MONITOR/PPR1
 
          ENDBLK
          BLOCK  ISDMMF,(SHARED DEVICE PROCESSING - MMF, LSPMMF OR ISD.)
 CMB      SPACE  4,15
**        CLEAR MRT BIT. (DROP TRACKS)
*         CALLED IN PROGRAM MODE.
*
*         ENTRY  (X0) = 12/ TRT LENGTH +2000B, 48/ MRT ADDRESS IN EM.
*                (X4) = -3777B.
*                (X7) = 2/ TRT BYTE, 40/, 18/ TRT WORD.
*                (A3) = ADDRESS OF *TDGL* MST WORD.
*                (B6) = TRT FWA.
*
*         EXIT   (X0) = 12/ TRT LENGTH +2000B, 48/ MRT ADDRESS IN EM.
*                (X4) = -3777B.
*                (A6) = MRT WORD.
*                (B3) = MRT FWA.
 
 
 CMB      LX7    -3          SET MRT ADDRESS AND BIT NUMBER
          BX5    X4*X7       MRT BIT NUMBER
          SX6    B1
          LX5    5
          SB3    X5
          LX6    X6,B3       POSITION MRT BIT
          UX1,B3 X0          UNPACK LENGTH OF TRT
          SB3    B3+B6
          SA1    B3+X7       READ MRT WORD
          BX6    -X6*X1      CLEAR BIT
          BX5    X6-X1
          SA6    A1
          LX7    3
          BX6    X6-X6
          NZ     X5,CMB1     IF MRT BIT SET FOR THIS MACHINE
          SA1    A5          TEST ALLOWING DROP TRACKS FOR OTHER MF
          LX1    59-46
          PL     X1,/PROGRAM/HNG  IF NOT ALLOWED TO DROP THIS FILE
 CMB1     TEQ    (/ISD/SMU,ISD,/PROGRAM/SMU,MMF,/LSPMMF/SMU)  COMPLETE
 SMB      SPACE  4,15
**        SET MRT BIT. (REQUEST TRACKS)
*         CALLED IN PROGRAM MODE.
*
*         ENTRY  (X0) = 12/ TRT LENGTH +2000B, 48/ MRT ADDRESS IN EM.
*                (X4) = TRACK NUMBER.
*                (A3) = ADDRESS OF *TDGL* MST WORD.
*
*         EXIT   (X0) = 12/ TRT LENGTH +2000B, 48/ MRT ADDRESS IN EM.
*                (X4) = TRACK NUMBER.
*                (A6) = MRT WORD.
*                (B3) = MRT FWA.
 
 
 SMB      MX6    -5
          BX6    -X6*X4
          SB3    X6          MRT BIT NUMBER
          SX6    B1
          LX6    X6,B3       POSITION MRT BIT
          UX1,B3 X0          UNPACK TRT LENGTH
          SA1    A3+TRLL-TDGL  SET FWA OF TRT
          SB3    X1+B3       (B3) = START OF MRT
          SX1    X4-4000B
          LX1    -5
          SA1    B3+X1       (A1) = MRT WORD ADDRESS
          BX6    X1+X6
          SA6    A1+
          SA0    /PROGRAM/TMSK-1      SCRATCH WORD
          TEQ    (/ISD/SMU,ISD,/PROGRAM/SMU,MMF,/LSPMMF/SMU)  COMPLETE
 STB      SPACE  4,10
*         STBM SET/CLEAR MRT BIT.
*         CALLED IN PROGRAM MODE.
*
*         ENTRY  (X0) = 12/ TRT LENGTH +2000B, 48/ MRT ADDRESS IN EM.
*                (X1) = 2/ TRT BYTE, 40/, 18/ TRT WORD.
*                (X4) = 0.
*                (A3) = ADDRESS OF *TDGL* MST WORD.
*                (B3) = RESERVATION BIT SHIFT COUNT (0=*STFS*/*CTFS*).
*                (B6) = TRT FWA.
*
*         EXIT   (X0) = 12/ TRT LENGTH +2000B, 48/ MRT ADDRESS IN EM.
*                (X4) = 0.
*                (A6) = MRT WORD.
*                (B3) = MRT FWA.
*                (B4) .LT. TRT FWA.
*                (X1) = FWA OF TRT TO UPDATE, IF NO MRT UPDATE.
*                (X5) = LWA + 1 OF TRT TO UPDATE, IF NO MRT UPDATE.
 
 
 STB10    UX6,B4 X0
          ZR     B3,STB12    IF FLAW REQUEST (NO MRT PROCESSING)
          LX1    2
          SX6    B3-6
          AX6    59
          MX3    -5
          BX3    -X3*X1      MRT BIT POSITION
          AX1    5           MRT WORD
          SB3    X3
          SX3    B1
          LX3    X3,B3       POSITION MRT BIT
          NZ     X5,STB11    IF STIS/SPFS OPTION
          BX6    -X6
 STB11    SB3    B4+B6
          BX6    X6*X3       NON ZERO IF SETTING MRT BIT
          SA1    B3+X1
          BX1    -X3*X1      CLEAR OLD BIT
          BX6    X1+X6       MERGE NEW BIT
          SA6    A1
          TEQ    (/ISD/SMU,ISD,/PROGRAM/SMU,MMF,/LSPMMF/SMU)  COMPLETE
 
 STB12    SX1    A4-B6       SET ONE WORD UPDATE FOR *CDI*
          SX5    X1+B1
          EQ     /PROGRAM/CCP1  RELEASE INTERLOCK
 
          ENDBLK
          BLOCK  BIOMMF,(SHARED BUFFERED DEVICE PROCESSING.)
 
          QUAL   BUFIO
 MTE      SPACE  4,10
**        MTE - PROCESS *MTEM* FUNCTION.
*
*         PARAMETERS ARE VALIDATED AND THE FUNCTION PASSED
*         TO *MTE*.
 
 
 MTE      BSS    0           ENTRY
          MX3    -12
          AX1    36
          SB4    X1-MXMTEM
          PL     B4,/MONITOR/HNG  IF INVALID SUBFUNCTION
          BX2    -X3*X5      ISOLATE PARAMETER
          LX5    -12         POSITION FOR NEXT PARAMETER
          JP     TMTE+TMTEL+B4  JUMP TO PROCESS FUNCTION
 
*         SUBFUNCTION TABLE.
 
 TMTE     BSS    0
          LOC    0
 
+         LX5    -12         (CBRS) - CLEAR BAT READ ACCESS
          BX4    -X3*X5      ISOLATE MACHINE INDEX
          EQ     MTE1        VALIDATE MACHINE INDEX/EST ORDINAL
 
+         LX5    -12         (CBWS) - CLEAR BAT READ/WRITE ACCESS
          BX4    -X3*X5
          EQ     MTE1        VALIDATE MACHINE INDEX/EST ORDINAL
 
+         BX4    -X3*X5      (CEMS) - CLEAR EXTENDED MEMORY TRACK
          LX5    -12
          EQ     MTE3        VALIDATE TRACK/SECTORS
 
+         BX4    -X3*X5      (EBRS) - ENABLE BRT PROCESSING
          EQ     /LSPMMF/QPR QUEUE *MTE* REQUEST
 
+         EQ     MTE2        (SEPS) - SET ERROR PROCESSING INTERLOCK
 
+         EQ     MTE2        (CEPS) - CLEAR ERROR PROCESSING INTERLOCK
 
+         EQ     /LSPMMF/QPR (SRIS) - SET RECOVERY ERROR INTERLOCK
 
+         EQ     /LSPMMF/QPR (CRIS) - CLEAR RECOVERY ERROR INTERLOCK
 
+         EQ     MTE2        (RBPS) - RELEASE BAT/BST PERMISSIONS
 
+         EQ     /LSPMMF/QPR (GRIS) - GET RECOVERY INTERLOCK STATUS
 
+         EQ     MTE2        (SRPS) - SET RESTORE PARITY INTERLOCK
 
+         EQ     MTE2        (CRPS) - CLEAR RESTORE PARITY INTERLOCK
 
+         EQ     MTE2        (GBDS) - GET *BDT* ENTRY
 
 
 TMTEL    BSS    0
          LOC    *O
 
 MTE1     SX4    X4-MXMF
          PL     X4,/MONITOR/HNG  IF INVALID MACHINE INDEX
 MTE2     CX4    X2,EST
          TA4    X4+EQDE,EST READ EST ENTRY
          BX1    X4
          LX4    59-57
          PL     X4,/MONITOR/HNG  IF NOT SHARED
          LX4    59-53-59+57
          PL     X4,/MONITOR/HNG  IF NOT BUFFERED
          TX0    X2,-ESTL
          BX0    X1*X0
          PL     X0,/MONITOR/HNG  IF NOT MASS STORAGE OR OUT OF EST
          MX0    -12         GET MST ADDRESS
          BX0    -X0*X1
          LX0    3
          SA1    X0+MDGL     GET *DAT* POINTER
          MX0    -8
          LX1    -48
          BX1    -X0*X1
          ZR     X1,/MONITOR/HNG  IF DEVICE IS NOT IN *DAT*
          EQ     /LSPMMF/QPR QUEUE FUNCTION FOR *MTE*
 
 MTE3     SX2    X2-4000B
          NG     X2,/MONITOR/HNG  IF INVALID TRACK TO CLEAR
          BX3    -X3*X5      FIRST SECTOR TO CLEAR
          IX3    X3+X4       COMPUTE LAST SECTOR TO CLEAR
          SA2    MMFL        GET LINK DEVICE EST ORDINAL
          MX0    -9
          LX2    -36
          BX2    -X0*X2
          CX4    X2,EST
          TA4    X4+EQAE,EST READ EST ENTRY
          LX4    -24
          MX0    -2
          BX4    -X0*X4      EXTENDED MEMORY SHIFT COUNT
          SB3    X4
          SX1    20B
          LX1    B3,X1       SECTOR LIMIT
          IX1    X3-X1
          PL     X1,/MONITOR/HNG  IF LAST SECTOR PAST TRACK END
          EQ     /LSPMMF/QPR QUEUE FUNCTION FOR *MTE*
 LBS      SPACE  4,10
**        LBS - *LBM* EXTENSION FOR SHARED DEVICES.
*
*         ENTRY  (B6) = BUFFER MANAGER OPERATION CODE.
*
*         EXIT   TO BUFFER MANAGER FUNCTION PROCESSOR.
*
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 6.
 
 
 LBS      BSS    0           ENTRY
          SA2    RTCL
          SA1    SDWR
          MX0    -36
          BX2    -X0*X2
          ZR     X1,LBS1     IF NO WRITE ACCESS REQUEST
          BX1    -X0*X1
          IX1    X2-X1
          NG     X1,LBS1     IF TIMEOUT NOT ELAPSED
          SX6    B0+         CLEAR STATUS
          SA6    A1+
 LBS1     SA1    SDUR
          ZR     X1,LBS2     IF NO UNABLE TO RELEASE ACCESS STATUS
          BX1    -X0*X1
          IX1    X2-X1
          NG     X1,LBS2     IF TIMEOUT NOT ELAPSED
          SX6    B0+         CLEAR STATUS
          SA6    A1+
 LBS2     JP     B6+LBMA     PROCESS FUNCTION
 CRR      SPACE  4,10
**        CRR - COMPLETE *MTE* REQUEST FOR READ ACCESS.
*
*         EXIT   TO *LBMX*.
*
*         USES   X - 0, 1, 2, 4, 5, 6, 7.
*                A - 1, 2, 6.
*                B - 4, 5.
*
*         CALLS  SBP.
 
 
 CRR      BSS    0           ENTRY
          SX5    2           SET NEW STATUS
          SX7    7           SET STATUS TO CHECK
 
*         ENTRY FROM *CWR*.
 
 CRR1     SA1    SDEO
          SB5    CRR2        SET *SBP* RETURN ADDRESS
          ZR     X1,/PROGRAM/HNG  IF NOT SHARED DEVICE
          EQ     SBP         SET BST PARAMETERS
 
 CRR2     NG     X2,/PROGRAM/HNG  IF BST PROCESSING DISABLED
          SA2    OPAR        GET COMPLETION STATUS
          BX7    X7*X4
          SX7    X7-1
          MX0    -1
          NZ     X7,/PROGRAM/HNG  IF INCORRECT STATUS FOR RESPONSE
          SB5    X2-1
          BX4    X0*X4       CLEAR REQUEST IN PROGRESS FLAG
          NG     B5,CRR3     IF NORMAL COMPLETION
          SX5    B0
          ZR     B5,CRR3     IF *BRT* ENTRY EVICTED BY *MTE*
          GT     B5,B1,/PROGRAM/HNG  IF INCORRECT RESPONSE STATUS
          LX1    48
          LX3    36
          SX7    B1+B1
          BX6    X1+X3       SET EST ORDINAL AND TRACK
          SA1    SDUR
          SA2    RTCL
          MX0    -36
          BX7    X7*X4
          NZ     X7,/PROGRAM/HNG  IF READ ACCESS CURRENTLY PRESENT
          SX7    SDUD
          NZ     X1,CRR3     IF STATUS WORD IN USE
          BX2    -X0*X2      SET TIMEOUT
          IX2    X2+X7
          BX6    X6+X2       SET UNABLE TO RELEASE ACCESS STATUS
          SA6    A1
 CRR3     SX1    60
          SB4    -B4
          BX4    X4+X5       SET NEW STATUS
          SB4    X1+B4       SHIFT COUNT TO RESTORE ENTRY
          LX6    B4,X4       UPDATE BST ENTRY
          SA6    A4+
          EQ     LBMX        EXIT BUFFER MANAGER
 CWR      SPACE  4,10
**        CWR - COMPLETE *MTE* REQUEST FOR WRITE ACCESS.
*
*         EXIT   TO *CRR1*.
*
*         USES   X - 5, 6.
 
 
 CWR      BSS    0           ENTRY
          SX5    6           SET NEW STATUS
          SX7    5           SET STATUS TO CHECK
          EQ     CRR1        EXIT TO READ ACCESS PROCESSOR
 RRA      SPACE  4,15
**        RRA - RELEASE READ ACCESS.
*
*         EXIT   TO *LBMX* IF ALL BUFFERS FLUSHED OR RELEASED.
*                TO *SIS* IF WRITE ERROR ON BUFFER FLUSH.
*                TO *SBB* IF ALL BUFFERS NOT FLUSHED OR RELEASED.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 3, 4, 6.
*                B - 4, 5, 6.
*
*         CALLS  CHA, DCC, DCH, LCC, SBP.
 
 
 RRA      BSS    0           ENTRY
          SX7    6           SET TO CLEAR READ AND WRITE ACCESS
 
*         SET BST INTERLOCK AND FIND HASH TABLE ENTRY.
*         ENTRY FROM *RWA*.
 
 RRA1     SA1    SDEO
          SB5    RRA2        SET RETURN ADDRESS
          ZR     X1,/PROGRAM/HNG  IF NOT SHARED DEVICE
          EQ     SBP         SET BST PARAMETERS
 
*         IN SOME CASES, *MTE* WILL REISSUE A *BMTR* OR *BMTW* REQUEST
*         THAT HAD BEEN PREVIOUSLY COMPLETED SUCCESSFULLY BY *CPUMTR*.
*         THIS IS NOT CONSIDERED AN ERROR CONDITION.
 
 RRA2     SX6    A4+
          BX2    X7*X4
          PX6    B4,X6
          ZR     X2,LBMX     IF REQUEST PREVIOUSLY PROCESSED
          SA6    RRAA        SAVE BST POINTERS
 
*         FIND HASH TABLE ENTRY.
 
 RRA3     SA7    RRAB        SAVE ACCESS INFORMATION
          SB6    RRA4        SET *CHA* RETURN ADDRESS
          SX7    -1          SET LOCATE HASH TABLE ENTRY
          EQ     CHA         CALCULATE HASH ADDRESS
 
 RRA4     SA3    RRAB
          BX7    X3          RESET ACCESS INFORMATION
          ZR     X1,RRA13    IF HASH TABLE ENTRY NOT FOUND
          SA3    X1          GET HASH TABLE ENTRY
          LX3    24
 
*         GET BUFFER STATUS.
 
 RRA5     LX3    -24
          MX0    -12
          BX6    -X0*X3      NEXT BUFFER ORDINAL
          BX0    -X0*X3
          SA6    INLB        SET/CLEAR BUFFER INTERLOCK
          LX6    CBTLS       SET BUFFER ADDRESS
          ZR     X6,RRA13    IF END OF BUFFERS
          TA2    X6+IOLK,CBT GET I/O INTERLOCK AND WRITE STATUS
          SA3    A2+B1       GET HASH LINK
          ERRNZ  HSLK-IOLK-1
          SA4    A3+B1       GET ACTIVITY COUNT
          ERRNZ  LSLK-HSLK-1
          MX1    1
          BX1    X1*X2       I/O INTERLOCK FLAG
          BX6    X3
          SA6    RRAC        SAVE HASH LINKAGE
          MX6    12
          BX4    X6*X4       ACTIVITY COUNT
          LX2    59-57
          BX4    X1+X4
          SX6    X0
          PL     X2,RRA8     IF NO WRITE DATA IN BUFFER
 
*         FLUSH AND RELINK WRITE BUFFER.
 
          MX1    1
          BX7    X7+X1       INDICATE WRITE BUFFER FOUND
          NZ     X4,RRA7     IF I/O INTERLOCK OR ACTIVITY PRESENT
          TA6    IORQ        SET I/O REQUEST
+         XJ                 FLUSH BUFFER
 
          SB6    RRA6        SET *DCC* RETURN ADDRESS
          EQ     DCC         DELINK BUFFER FROM CURRENT LIST
 
 RRA6     SB6    RRA11       SET *LCC* RETURN ADDRESS
          TX1    DWTB
          EQ     LCC         LINK BUFFER TO DATA WRITTEN LIST
 
 RRA7     PL     X3,RRA11    IF NO WRITE ERROR
          SX1    B1
          LX1    57-0
          BX7    X7+X1       SET WRITE ERROR
          EQ     RRA11       SET BUFFER NOT RELEASED
 
*         DELINK READ BUFFER FROM HASH TABLE.
 
 RRA8     SX1    X7-4
          ZR     X1,RRA11    IF RELEASING WRITE ACCESS
          NZ     X4,RRA11    IF I/O INTERLOCK OR ACTIVITY PRESENT
          SB6    RRA9        SET *DCH* RETURN ADDRESS
          EQ     DCH         DELINK BUFFER FROM HASH TABLE
 
 RRA9     SB6    RRA10       SET *DCC* RETURN ADDRESS
          EQ     DCC         DELINK BUFFER FROM CURRENT LIST
 
 RRA10    SB6    RRA12       SET *LCC* RETURN ADDRESS
          TX1    EMTB
          EQ     LCC         LINK BUFFER TO EMPTY LIST
 
*         SET BUFFER NOT RELEASED.
 
 RRA11    SX1    1
          LX1    58-0
          BX7    X7+X1       INDICATE BUFFER NOT RELEASED
 
*         ADVANCE TO NEXT BUFFER.
 
 RRA12    SA3    RRAC        RESTORE *HSLK* INFORMATION
          EQ     RRA5        PROCESS NEXT BUFFER
 
*         CHECK FOR MULTI-UNIT EQUIPMENT.
 
 RRA13    SA1    PUTO
          MX0    -12
          BX2    -X0*X1      CURRENT PUT ORDINAL
          LX2    PUTLS
          TA2    X2+HSCT,PUT
          BX2    -X0*X2      NEXT PUT ORDINAL
          ZR     X2,RRA14    IF END OF UNITS
          SA2    LSEC
          AX1    36          SINGLE UNIT SECTOR LIMIT
          IX6    X2+X1       ADVANCE SECTOR TO NEXT UNIT
          SA6    A2+
          EQ     RRA3        PROCESS NEXT UNIT
 
*         CLEAR ACCESS FLAGS IN BST IF ALL BUFFERS RELEASED OR FLUSHED.
*         IF ANOTHER MACHINE IS WAITING FOR WRITE ACCESS TO THE TRACK
*         AND NO ACTIVITY REMAINS ON THIS MACHINE, THE TIMEOUT DELAY IN
*         *SDWR* IS SET TO *SDMD* MILLISECONDS FROM THE CURRENT TIME.
*         THIS IS TO ALLOW *MTE* ON THE MACHINE REQUESTING WRITE ACCESS
*         TIME TO PROCESS THE REQUEST.
 
 RRA14    SA4    RRAA
          BX1    X7
          LX1    3
          SX7    X7          STATUS FLAGS TO CLEAR
          SX1    X1          CURRENT BUFFER ACCESS STATUS
          BX2    X1*X7
          UX4,B4 X4          RESET BST PARAMETERS
          NZ     X2,RRA15    IF NOT ALL BUFFERS RELEASED/FLUSHED
          SA4    X4          GET BST ENTRY
          LX4    B4
          SB5    60
          BX4    -X7*X4      CLEAR READ/WRITE ACCESS
          SB4    B5-B4
          LX6    X4,B4
          SA6    A4          UPDATE BST ENTRY
          SX1    X7-6
          NZ     X1,LBMX     IF NOT RELEASING READ ACCESS
          SA1    SDWR
          SA3    LTRK
          SA4    SDEO
          AX1    36
          LX4    12
          BX4    X4+X3
          BX6    X4-X1
          NZ     X6,LBMX     IF NO WAIT REQUEST FOR TRACK
          SA2    RTCL
          MX0    -36
          LX1    36
          SX7    SDMD
          BX6    X1+X7
          BX2    -X0*X2
          IX6    X6+X2       SET TIME DELAY
          SA6    A1          UPDATE REQUEST
          EQ     LBMX        EXIT WITH NORMAL STATUS
 
*         PROCESS ERROR RETURN.
 
 RRA15    LX1    59-0
          MX0    -36
          NG     X1,SIS      IF WRITE ERROR ON FLUSH
          SX1    X7-6
          NZ     X1,SBB      IF NOT RELEASING READ ACCESS
          SA1    SDWR
          SA2    RTCL
          SA3    LTRK
          SA4    SDEO
          NZ     X1,SBB      IF STATUS WORD IN USE
          SX7    SDWD        SET TIME DELAY
          BX2    -X0*X2
          LX3    36
          LX4    48
          IX7    X2+X7       SET TIMEOUT
          BX6    X4+X3       MERGE EST ORDINAL AND TRACK
          BX6    X6+X7       MERGE TIMEOUT
          SA6    A1+         SET WRITE ACCESS REQUESTED
          EQ     SBB         RETURN BUFFER BUSY STATUS
 
 
 RRAA     BSS    1           BST PARAMETERS
 RRAB     BSS    1           ACCESS MASK
 RRAC     BSS    1           CURRENT *HSLK* WORD
 RWA      SPACE  4,10
**        RWA - RELEASE WRITE ACCESS.
*
*         EXIT   TO *RRA1* TO PROCESS FUNCTION.
*
*         USES   X - 7.
 
 
 RWA      BSS    0           ENTRY
          SX7    4           SET TO CLEAR WRITE ACCESS
          EQ     RRA1        EXIT TO PROCESS FUNCTION
 CSD      SPACE  4,25
**        CSD - CHECK SHARED DEVICE ACCESS.
*
*         ENTRY  (B6) = *CHA* RETURN ADDRESS.
*                (X7) = BUFFERS ALLOCATED FLAG.
*
*         EXIT   TO *CHA* IF NOT SHARED DEVICE OR IF SHARED DEVICE AND
*                  BUFFER CAN BE ACCESSED.
*                TO *CHA* RETURN ADDRESS IF SHARED DEVICE AND BUFFER
*                  CANNOT BE ACCESSED IN REQUESTED MODE.
*                TO *SIS* IF BUFFER ON MACHINE HOLDING WRITE ACCESS
*                  CANNOT BE FLUSHED (DEVICE INACCESSIBLE).
*                (X2) = -2 (REQUIRED FOR EXIT TO *CHA* CALLER WHEN
*                          BUFFER CANNOT BE ACCESSED IN REQUESTED
*                          MODE).
*                (X7) = BUFFERS ALLOCATED FLAG.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 6.
*                B - 4, 5.
*
*         CALLS  SBP.
 
 
 CSD      BSS    0           ENTRY
 
*         ENTRY FOR READ ACCESS.
 
          SX5    2           SET TO CHECK READ ACCESS
          EQ     CSD2
 
*         ENTRY FOR WRITE ACCESS.
 
 CSD1     SX5    4           SET TO CHECK WRITE ACCESS
 
*         CHECK ACCESS TO SHARED DEVICE.
 
 CSD2     SA1    SDEO        GET EST ORDINAL IF SHARED DEVICE
          ZR     X1,CHA      IF NOT SHARED DEVICE
          SB5    CSD3        SET *SBP* RETURN ADDRESS
          EQ     SBP         SET BST PARAMETERS
 
 CSD3     NG     X2,CHA      IF BST PROCESSING DISABLED
          SA2    SDWR
          LX1    48
          LX3    36
          MX0    24
          BX6    X1+X3       FORMAT EST ORDINAL AND TRACK FOR REQUEST
          BX1    X5*X4
          BX2    X0*X2
          AX5    2
          BX2    X2-X6
          ZR     X2,CSD4     IF WRITE ACCESS REQUESTED ON OTHER MACHINE
          NZ     X1,CHA      IF REQUESTED ACCESS PRESENT
          SA2    SDUR
          BX2    X0*X2
          BX2    X2-X6
          ZR     X2,SIS      IF UNABLE TO RELEASE WRITE ACCESS
 
*         MAKE *MTE* REQUEST.
 
          SX0    B1
          BX1    X0*X4
          NZ     X1,CSD4     IF *MTE* REQUEST ALREADY IN PROGRESS
          SA1    /LSPMMF/MTIN  READ *IN*
          SA2    A1+B1       READ *OUT*
          ERRNZ  /LSPMMF/MTOT-/LSPMMF/MTIN-1
          LX5    35-0
          BX6    X6+X5       SET READ/WRITE FLAG IN REQUEST
          BX4    X4+X0       SET *MTE* REQUEST FLAG
          MX0    -6
          SX3    X1+B1
          BX3    -X0*X3      NEW *IN*
          BX2    X2-X3
          ZR     X2,CSD4     IF REQUEST QUEUE FULL
          SA6    X1+/LSPMMF/MTBT  ENTER REQUEST
          SX6    X3
          SA6    A1          UPDATE *IN*
 
*         UPDATE BST ENTRY.
 
          SX1    60
          SB4    -B4
          SB4    X1+B4       SHIFT COUNT TO RESTORE ENTRY
          LX6    X4,B4
          SA6    A4
 
*         EXIT TO CALLER OF *CHA*.
 
 CSD4     SX2    -2          SET ACCESS REJECTED STATUS
          JP     B6          EXIT TO *CHA* CALLER
 IPP      SPACE  4,10
**        IPS - *IPP* PREPROCESSOR FOR SHARED DEVICES.
*
*         ENTRY  SEE *CPUCIO* SPECIAL PROCESSOR DOCUMENTATION.
*
*         EXIT   TO *IPP0* IF REQUEST CAN BE PROCESSED BY PSEUDO-PP.
*                TO */CPUCIO/RPC* IF REQUEST CANNOT BE PROCESSED BY
*                  PSEUDO-PP.
*
*         USES   X - 1, 2.
 
 
 IPS      BSS    0           ENTRY
          BX1    X3
          LX1    59-57
          PL     X1,IPP0     IF NOT SHARED DEVICE
          EQ     B3,B1,/CPUCIO/RPC  IF WRITE FUNCTION
          ERRNZ  /CIO/WTF-1
          SX1    1
          IX1    X0-X1       FNT ADDRESS
          ERX1   X1          READ FNT ENTRY
          MX2    -6
          LX1    0-6
          BX2    -X2*X1      FILE TYPE
          LX1    59-16-0+6
          SX2    X2-PMFT
          NZ     X2,IPP0     IF NOT DIRECT ACCESS PERMANENT FILE
          PL     X1,IPP0     IF NOT M, A, RM, OR RA MODE
          EQ     /CPUCIO/RPC CALL PP CIO
 SBP      SPACE  4,15
**        SBP - SET BST PARAMETERS.
*
*         ENTRY  (B5) = RETURN ADDRESS.
*
*         EXIT   (X2) .LT. 0 IF BST PROCESSING DISABLED.
*                (X3) = LOGICAL TRACK.
*                (X4) = BST WORD WITH ENTRY RIGHT JUSTIFIED.
*                (A4) = BST WORD ADDRESS.
*                (B4) = SHIFT COUNT TO POSITION ENTRY.
*
*         USES   X - 2, 3, 4, 6.
*                A - 2, 3, 4.
*                B - 4.
 
 
 SBP      BSS    0           ENTRY
          SA2    MSTA        GET MST ADDRESS
          SA2    X2+BDLL
          SA3    LTRK        GET TRACK
          LX2    -24
          SB4    X2          SET BST ADDRESS
          NG     X2,RB5      IF BST PROCESSING DISABLED
          SX4    X3-4000B
          MX6    -4
          BX6    -X6*X4      ENTRY ORDINAL IN WORD
          AX4    4           BST WORD OFFSET
          SA4    B4+X4       READ BST ENTRY
          SX6    X6+B1       ENTRIES TO SHIFT TO RIGHT JUSTIFY ENTRY
          SB4    X6
          LX6    1
          SB4    X6+B4       SHIFT COUNT TO POSITION ENTRY
          LX4    B4          POSITION TO ENTRY
          JP     B5          RETURN
 
 
          QUAL   *
 
          ENDBLK
          BLOCK  CPUCIO,(CPUCIO PROCESSOR.)
          TITLE  CPUCIO GLOBAL DATA.
          SPACE  4,10
**        GLOBAL DATA.
 
 
*         THE FOLLOWING DATA IS ORDER DEPENDENT.
 
 IR       BSS    1           *CIO* CALL
 MB       BSS    1           *CIO* PARAMETERS
 MB1      BSS    1           12/0, 24/IN, 24/OUT
 MB2      BSS    1           1/R,5/0,6/FET LENGTH,24/FIRST,24/LIMIT
 MB3      BSS    1           FUNCTION FLAGS
 
 
          ERRNZ  /CIO/RDF    CODE DEPENDS ON INTERNAL CODE FOR READ
          ERRNZ  /CIO/WTF-1  CODE DEPENDS ON INTERNAL CODE FOR WRITE
          ERRNZ  FSTL-1      CODE DEPENDS ON POSITION OF FST
          ERRNZ  FUTL-FSTL-1 CODE DEPENDS ON POSITION OF WORD
          TITLE  CPUCIO EXIT ROUTINES.
 PMV      SPACE  4,10
**        PMV - PROCESS *MAGNET* MOVING.
 
 
 PMV      SB5    PMV1        SER *SRC* RETURN ADDRESS
          EQ     SRC         SET *RCLP* IN RA+1
 
 PMV1     SB5    MVPR        SET RECALL STACK REASON CODE
*         EQ     RCR         SET REQUEST IN RECALL QUEUE
 RCR      SPACE  4,10
**        RCR - REQUEST *CIO* RECALL.
*
*         ENTRY  (B5) = RECALL STACK REASON CODE.
*                (IR) = *CIO* CALL.
*                (MB) = *CIO* MESSAGE BUFFER PARAMETERS.
*
*         EXIT   TO *CPCX*.
*
*         CALLS  /MONITOR/AQR.
 
 
 RCR      SA4    IR          GET *CIO* CALL
          SX7    B5          RECALL STACK REASON CODE
          MX3    6
          SA1    MB          *CIO* PARAMETER WORD
          LX7    -12
          BX6    X4
          LX3    -6
          BX1    -X3*X1
          R=     X2,/MONITOR/RQ
          BX7    X7+X1
          SA1    RTCL
          SA7    /MONITOR/AQRA  SAVE PARAMETER WORD
          MX3    -36
          SA4    RCRA        GET RECALL TIME PARAMETERS
          BX1    -X3*X1
          LX1    12
          IX0    X1+X4
          SA1    B7+STSW
          SB3    CPCX        SET RETURN ADDRESS FOR *AQR*
          LX1    59-24
          PL     X1,/MONITOR/AQR  IF ROLLOUT NOT SET
          BX2    X7
 
 
*         ROLLOUT SET ON CONTROL POINT -
*         PLACE REQUEST IN CPA RECALL AREA, BUT NOT IN QUEUE.
*
*         ENTRY  (A1) = ADDRESS OF *STSW*.
*                (X1) = *STSW* LEFT-SHIFTED 59-24
*                (X2) = PARAMETER WORD.
*                (X6) = PP REQUEST.
*                (B3) = RETURN ADDRESS.
*                (B7) = CONTROL POINT AREA ADDRESS.
 
 
 RCR1     LX1    24-59
          MX7    -4
          SB4    B7+RCCW-1
          BX4    -X7*X1      NEXT FREE RECALL SLOT
          BX7    X7*X1
          SA3    B4+X4       READ NEXT FREE RECALL SLOT
          MX4    1
          SA6    A3+RECW-RCCW  STORE REQUEST
          SX3    X3+20B
          BX6    X2+X4       SET RECALL BIT
          IX7    X7+X3
          SA6    A3+REPW-RCCW  STORE PARAMETER WORD
          SA7    A1          UPDATE STSW
          JP     B3          RETURN
 
 
 RCRA     VFD    12/PTMF,36/IORT,12/0  RECALL TIME PARAMETERS
 RET      SPACE  4,10
**        RET - RETURN FILE.
 
 
 RET      BSS    0
          BX1    X3
          LX1    59-56
          BX3    X1*X3
          PL     X3,RPC      IF NOT REMOVABLE MASS STORAGE
 
*         FORCE AUTORECALL TO PREVENT TWO FILE RETURNS ON A REMOVABLE
*         DEVICE FROM OCCURRING SIMULTANEOUSLY. THIS PREVENTS EACH
*         RETURN FROM DECIDING THAT ITS NOT THE LAST FILE ON THE DEVICE
*         AND, THUS, NOT DECREMENTING THE RESOURCE COUNT.
 
          SA1    IR
          MX2    1
          LX2    41-59
          BX6    X2+X1
          SA6    A1
*         EQ     RPC         REQUEST PP CIO
 RPC      SPACE  4,15
**        RPC - REQUEST PP CIO.
*
*         ENTRY  (X7) = 18/*TAPQ* INDEX, 42/REQUEST PARAMETERS.
*                (IR) = *CIO* CALL.
*                (MB) = *CIO* MESSAGE BUFFER PARAMETERS.
*                (MB1) = FET LENGTH - 5, FIRST AND LIMIT.
*                (MB2) = IN AND OUT.
*
*         EXIT   TO *CPCX*.
*
*         CALLS  /MONITOR/APQ.
 
 
 RPC      SA1    IR          GET *CIO* CALL
          MX0    -6
          SA4    A1+B1       CLEAR RECALL STACK FLAG
          BX0    -X0*X7
          SB3    CPCX        SET RETURN ADDRESS FOR *APQ*
          MX6    -59
          MX2    -42         PRESERVE ERROR CODE AND PARAMETERS
          BX6    -X6*X4
          BX4    -X2*X7
          LX4    36
          BX6    X6+X4
          SA6    A4
          SA6    /MONITOR/APQA
          ZR     X0,RPC1     IF NO ERROR
          MX2    1           FORCE AUTO RECALL ON ERROR
          LX2    41-59
          BX6    X1+X2
          SA6    A1+         REWRITE INPUT REGISTER
          BX1    X6
 
*         INDEX INTO TABLE *TAPQ* TO BUILD PP REQUEST.
 
 RPC1     AX7    42          *TAPQ* OFFSET
          SA2    TAPQ+X7
          MX6    18
          SB4    X2          PP FAST LOAD ADDRESS FROM *TAPQ*
          BX1    -X6*X1
          BX6    X6*X2
          BX6    X6+X1
          SA1    B7+STSW     CHECK IF ROLLOUT REQUESTED
          LX1    59-24
          TPL    X1,(/DCP/APQ,DCPC,/MONITOR/APQ)  IF ROLLOUT NOT SET
          SA2    /MONITOR/APQA
          EQ     RCR1        SET REQUEST IN CPA
 TAPQ     SPACE  4,10
**        TAPQ - TABLE OF PP REQUEST CRITERIA.
*
*         ENTRY  ONE WORD.
*
*T        18/PP CALL, 42/PP FAST LOAD PARAMETER ADDRESS
 
 
 TAPQ     BSS    0
          LOC    0
 
          VFD    18/3L1MS,42//MONITOR/LA1MS
          VFD    18/3L1MI,42//MONITOR/LA1MI
          VFD    18/3L1ML,42//MONITOR/LA1ML
          VFD    18/3L1OD,42//MONITOR/LA1OD
 
          LOC    *O
 
 TAPQL    EQU    *-TAPQ      PP REQUEST TABLE LENGTH
 SRC      SPACE  4,10
**        SRC - SET *RCLP* AND CLEAR RECALL STATUS IN REQUEST.
*
*         ENTRY  (B5) = EXIT ADDRESS.
*                (IR) = *CIO* CALL.
*
*         USES   X - 1, 2, 3, 6.
*                A - 1, 2, 6.
 
 
 SRC      BSS    0
          SA1    IR
          LX1    59-41
          MX6    -59
          PL     X1,SRC1     IF NOT AUTO RECALL
          BX6    -X6*X1      CLEAR AUTO RECALL
          LX6    41-59
          SA2    /MONITOR/RC *RCLP* REQUEST
          SA6    A1
          SX3    X6          EXTRACT FET ADDRESS
          SA1    B7+FLSW     GET RA
          BX6    X2+X3
          MX2    -RMSK
          AX1    RSHF
          BX3    -X2*X1
          SX1    B1          STORE *RCLP* IN RA + 1
          LX3    6
          IX3    X3+X1
          EWX6   X3
 SRC1     JP     B5          RETURN
 CPCX     SPACE  4,15
**        CPCX - CPUCIO EXIT PROCESSOR.
*
*         ENTRY  (A0) = CPU NUMBER.
*                (A5) = PP *OR* ADDRESS OR CP RA+1 ADDRESS.
*                (B1) = 1.
*                (B2) = USER EXCHANGE PACKAGE AREA.
*                (B7) = CPA.
*                (IR) = *CIO* CALL.
*
*         EXIT   TO */MONITOR/.DPPM* IF PP REQUEST COMPLETE AND
*                   DROP OPTION SELECTED.
*                TO */MONITOR/MTR* IF RA+1 CALL WITHOUT AUTO RECALL
*                   FLAG SET.
*                TO */MONITOR/MTRX* IF RECALLED REQUEST OR IF RA+1 CALL
*                   WITHOUT AUTO RECALL WHEN JOB NOT ACTIVE IN CPU.
*                TO */MONITOR/PPR1* IF PP REQUEST COMPLETE AND
*                   DROP OPTION NOT SELECTED.
*                TO */MONITOR/SIS* IF RA+1 CALL WITH AUTO RECALL
*                   WHEN JOB ACTIVE IN CPU.
 
 
 CPCX     TX1    10B,SP
          SX2    A5
          MX0    -18
          BX2    -X0*X2
          IX1    X2-X1
          ZR     X1,/MONITOR/MTRX  IF RECALLED REQUEST
          NG     X1,CPCX1    IF PP *RPPM* REQUEST
          SA1    IR
          MX0    3
          LX1    59-41
          PL     X1,/MONITOR/MTR  IF NO AUTO RECALL
          SA1    B7+STSW     GET CPU STATUS
          NO
          BX0    X0*X1
          ZR     X0,/MONITOR/MTRX  IF NULL CPU STATUS
          PL     X1,/MONITOR/SIS  IF JOB ACTIVE IN CPU
          EQ     /MONITOR/MTRX  EXIT
 
 CPCX1    SA5    A5
          LX5    59-37
          NG     X5,/MONITOR/.DPPM  IF DROP OPTION SELECTED
          SX7    B1          RETURN RESPONSE
          LX7    36
          EQ     /MONITOR/PPR1
          TITLE  CPUCIO MAIN ROUTINE.
 CPC      SPACE  4,10
**        CPC - CPUCIO PROCESSOR (MONITOR MODE ENTRY POINT).
*
*         ENTRY  (A0) = CPU NUMBER.
*                (B1) = 1.
*                (B2) = USER EXCHANGE PACKAGE AREA.
*                (B7) = CPA.
*                (A5) = PP *OR* ADDRESS OR CP RA+1 ADDRESS.
*                (IR) = *CIO* CALL.
*                (MB) = *CIO* PARAMETER WORD IF RESTART.
*                     = 0 IF INITIAL *CIO* CALL.
*
*         EXIT   TO */CIO819/IPP1* IF PSEUDO PP CONTINUATION FUNCTION.
*                TO EQUIPMENT FUNCTION PROCESSOR (SEE *TFPJ* TABLE).
*
*         ERROR  EXIT TO *RPC* IF ERROR DETECTED.
*
*         CALLS  /MONITOR/VFA, /MONITOR/VFP.
 
 
*         VALIDATE FET ADDRESS.
 
 CPC      SA4    MB          CHECK IF CONTINUATION FUNCTION
          MX1    -59
          BX4    -X1*X4      IGNORE RECALL STACK FLAG
          SX6    B0+
          MX1    -54
          LX4    59-55
 CPC1     TNG    X4,(/BUFIO/IPP1,BUFIO,/CPUCIO/CPC1)  IF BUFFERED I/O
          LX4    59-53-59+55
          BX4    -X1*X4      IGNORE RECALL STACK REASON CODE
          SA6    A4+B1       CLEAR FET PARAMETER WORDS
          SA1    A4-B1       GET FET ADDRESS
          SA6    A6+B1
          SA6    A6+B1
          SX7    /CIOERR/ARG *FET ADDRESS OUT OF RANGE*
          SB3    RPC         SET ERROR EXIT ADDRESS FOR *VFA*
          SB6    CPC3        SET RETURN ADDRESS FOR *VFA*
          ZR     X4,/MONITOR/VFA  IF INITIAL CALL
          SB6    CPC2        SET RETURN ADDRESS FOR *VFA*
          EQ     /MONITOR/VFA  VALIDATE FET ADDRESS
 
 CPC2     SA4    A4
          MX2    -12
          SA6    MB2         SAVE FET LENGTH - 5 AND RANDOM FILE FLAG
          LX4    -24
          BX2    -X2*X4      FNT ORDINAL
          SX2    X2-FSTL
          IX0    X0-X2       ABSOLUTE FST ADDRESS
          LX4    24
          EQ     CPC16       VERIFY FET PARAMETERS
 
 CPC3     SA6    MB2         SAVE FET LENGTH - 5 AND RANDOM FILE FLAG
          MX4    -12
          LX2    -36
          SX6    B1+
          BX2    -X4*X2      NFL/100B
          IX3    X5-X6       FET+0
          MX6    -2
          ERX3   X3
          IX5    X5-X6       FET+4
          MX6    42
          SX7    /CIOERR/FLN *FILE NAME ERROR*
          BX1    X6*X3
          LX2    6
          ZR     X1,RPC      IF NO FILE NAME
 
*         CHECK FNT POINTER FROM FET.
 
          SX7    FNTN
          ERX1   X5          GET FNT POINTER FROM FET
          IX0    X0-X7
          LX1    12
          BX1    -X4*X1      FNT ORDINAL
          IX4    X2-X1
          IX1    X1-X7
          IX2    X2-X7
          PX2    X2
          NG     X1,CPC4     IF FNT POINTER TOO SMALL
          NG     X4,CPC4     IF FNT POINTER TOO LARGE
          IX0    X0-X1       ABSOLUTE FNT ADDRESS
          ERX4   X0          GET FNT ENTRY
          BX4    X3-X4
          BX4    X6*X4
          IX6    X1+X7       FNT ORDINAL
          ZR     X4,CPC7     IF FILE NAME MATCH
          IX0    X0+X1
 
*         LOCATE FNT ENTRY.
 
 CPC4     SX7    LENF        COMPUTE ADDRESS OF LAST FNT ENTRY
          PX4    X7
          NX4    X4
          FX2    X2/X4
          UX2    X2,B6
          LX2    B6
          IX2    X7*X2
          BX6    X3
          IX4    X0-X2
          EWX6   X4          STORE FILE NAME FOR MATCH
          MX6    42
 CPC5     ERX1   X0
          IX0    X0-X7
          ERX2   X0
          BX1    X1-X3
          BX1    X6*X1
          ZR     X1,CPC6     IF FOUND
          BX2    X2-X3
          IX0    X0-X7
          BX2    X6*X2
          NZ     X2,CPC5     IF NOT FOUND
 CPC6     IX1    X0+X7
          BX6    X6-X6       CLEAR FILE NAME FROM END OF FNT
          IX0    X4-X1
          EWX6   X4
          ZR     X0,CPC8     IF FILE NOT FOUND
          SA2    B7+FLSW     GET RA
          BX0    X1
          MX7    -48
          LX2    -12
          ERX1   X5          SET FNT ORDINAL IN FET
          SX2    X2
          BX7    -X7*X1
          LX2    6
          IX6    X2-X0       FNT ORDINAL
          LX6    -12
          BX7    X6+X7
          EWX7   X5
          LX6    12
 
*         CHECK FILE BUSY.
 
 CPC7     SX2    B1
          ERRNZ  FSTL-1      CODE DEPENDS ON VALUE
          IX0    X0+X2       ABSOLUTE FST ADDRESS
          ERX1   X0          CHECK FILE BUSY
          BX4    X2*X1
          SX7    /CIOERR/FSQ *I/O SEQUENCE ERROR*
          ZR     X4,RPC      IF FILE BUSY
          BX7    X1-X2       SET FILE BUSY
          EWX7   X0
 
*         IDENTIFY *CIO* REQUEST.
 
 CPC8     LX3    -14         GET LEVEL NUMBER
          MX4    -4
          BX1    -X4*X3
          MX4    -8
          LX3    13          GET EXTERNAL CIO FUNCTION CODE
          BX3    -X4*X3
          LX1    8
          BX1    X1+X3
          SX2    B1
          LX6    12
          AX3    1
          BX4    -X3*X2
          SB3    X3-600B/4
          BX6    X6+X1
          LX6    12
          SX2    30
          LX3    -4
          IX4    X2*X4
          SX1    X3-3
          SA6    MB          SAVE FNT ORDINAL AND EXTERNAL CODE
          SX7    /CIOERR/IRQ *ILLEGAL I/O REQUEST ON FILE*
          NG     X1,CPC9     IF 0XX, 1XX, OR 2XX FUNCTION CODE
          SX2    B1+B1
          IX3    X3-X2       MAP 3XX INTO 1XX FUNCTION CODE
          ZR     X1,CPC9     IF 3XX FUNCTION CODE
          LX2    1
          IX3    X3-X2       MAP 6XX INTO 0XX FUNCTION CODE
          MX1    -3
          BX1    -X1*X3
          NZ     X1,RPC      IF NOT 6XX FUNCTION CODE
 CPC9     LX3    3
          SA3    TCIC+X3     GET INTERNAL CODE AND FUNCTION FLAGS
          SB6    X4
          LX3    B6
          LX3    -18
          MX2    48
          BX1    X1+X3
          PL     X1,RPC      IF NOT LEGAL 3XX/6XX FUNCTION CODE
          BX1    X2+X3
          BX4    -X2*X3      INTERNAL CIO FUNCTION CODE
          ZR     X1,RPC      IF ILLEGAL FUNCTION CODE
          LX7    X3          SAVE FUNCTION FLAGS
          LX3    59-56       CHECK IF FNT REQUIRED
          SA7    MB3
          MX7    1
          BX1    -X3*X7
          LX7    6-59
          BX1    X1+X0
          SB5    RPC
          ZR     X1,SRC      IF FNT REQUIRED AND NOT FOUND
          NZ     B3,CPC10    IF NOT 600 FUNCTION CODE
          SX4    X4+/CIO/EOI SET EOI TERMINATION CONDITION
 
*         PROCESS SKIP COUNT AND LEVEL NUMBER.
 
 CPC10    BX3    X6
          AX3    20          GET LEVEL NUMBER
          MX7    56
          BX3    X7+X3
          SA1    A6-B1
          MX2    42
          LX2    18
          BX7    X2*X1       CLEAR SKIP COUNT
          BX2    -X2*X1
          SX1    1754B
          BX1    X1*X4       FUNCTION CODE AND TERMINATION CONDITION
          SB3    X1-/CIO/SKP*100B-/CIO/PRU
          ZR     B3,CPC12    IF BACKSPACE PRU FUNCTION
          SB3    X1-/CIO/SKP*100B-/CIO/EOR
          ZR     B3,CPC11    IF SKIP RECORD FUNCTION
          SX2    B1+
          NZ     X3,CPC14    IF NOT LEVEL 17B
          SB3    X1-/CIO/WTF*100B-/CIO/EOR
          ZR     B3,CPC13    IF WRITER/REWRITER
          SX3    X1-/CIO/RDF*100B-40B-/CIO/EOI
          NZ     X3,CPC14    IF NOT *READCW*
          SX4    X4+/CIO/EOF-/CIO/EOI  STOP ON EOF
          EQ     CPC14       UPDATE PARAMETER WORD
 
 CPC11    NZ     X3,CPC12    IF NOT LEVEL 17B
          SX4    X4+/CIO/EOF-/CIO/EOR  SET EOF STOP
 CPC12    MX3    1           SET SKIP DATA TRANSFER FLAG
          LX3    56-59
          BX6    X6+X3
          LX2    -18
          SX3    X2
          NZ     X3,CPC14    IF SKIP COUNT SPECIFIED
          SX3    B1          SET SKIP COUNT = 1
          LX3    18
          BX7    X7+X3
          SA7    A1+
          ZR     X2,CPC14    IF SKIP COUNT NOT INDEFINITE
          SX3    /CIO/EOI    SET STOP ON EOI FOR FORWARD SKIP
          BX4    X4+X3
          BX7    X4
          MX2    7
          LX7    59-11
          PL     X7,CPC14    IF FORWARD SKIP
          SX4    X4+/CIO/REW*100B-/CIO/SKP*100B-/CIO/EOI  SET REWIND
          SX3    50B/2
          LX2    19-59
          BX6    -X2*X6
          LX3    12
          BX6    X6+X3
          EQ     CPC14       UPDATE FET+0
 
 CPC13    SX4    X4+/CIO/EOF-/CIO/EOR  SET WRITEF/REWRITEF FUNCTION
          LX2    14-0
          IX6    X6+X2       SET EXTERNAL FUNCTION CODE
 CPC14    BX6    X6+X4       SET INTERNAL CODE IN PARAMETER WORD
          SA6    A6
          LX6    -12
          MX7    -8
          BX6    -X7*X6      UPDATE EXTERNAL CODE IN FET
          SX3    4
          LX6    1
          IX5    X5-X3       GET FET+0
          ERX2   X5
          MX7    46
          BX7    X7*X2       CLEAR ABNORMAL TERMINATION FIELD
          IX7    X7+X6
          EWX7   X5
          SX6    B1
          IX5    X5+X6       FET+1
 
*         CHECK FILE ACCESS.
 
          SA4    A6
          ZR     X0,CPC16    IF NO FNT ENTRY
          IX2    X0-X6
          ERX2   X2          GET FNT ENTRY
          AX1    6
          LX2    59-14
          SB5    X1          INTERNAL FUNCTION CODE
          PL     X2,CPC15    IF NOT EXECUTE-ONLY FILE
          SA1    B7+EOCW     CHECK LAST FILE EXECUTED
          SA3    B7+SEPW     CHECK SPECIAL ENTRY POINTS
          MX7    12
          LX4    24
          BX1    X1-X4
          LX3    59-55
          BX1    X1*X7
          LX4    -24
          ZR     X1,CPC15    IF PROGRAM LOADED FROM THIS FILE
          NG     X3,CPC15    IF LDR= PROGRAM
          SA1    MB3         GET FUNCTION FLAGS
          SX7    /CIOERR/EXO *I/O ON EXECUTE-ONLY FILE*
          LX1    59-54
          PL     X1,RPC      IF FUNCTION INVALID ON EXECUTE ONLY FILE
 CPC15    SX1    B5-/CIO/OVW
          LX2    59-12-59+14
          ZR     X1,CPC15.1  IF OVERWRITE FUNCTION
          NE     B5,B1,CPC16 IF NOT WRITE FUNCTION
 CPC15.1  SX7    /CIOERR/IWR *WRITE ON READ ONLY FILE*
          NG     X2,RPC      IF WRITE LOCKOUT SET
 
*         VERIFY FET PARAMETERS.
 
 CPC16    MX1    -2          GET VALIDATION FLAGS
          BX6    -X1*X4
          ZR     X6,CPC18    IF NO VALIDATION REQUIRED
          SB6    CPC17       SET RETURN ADDRESS FOR *VFP*
          SB3    RPC         SET ERROR EXIT ADDRESS FOR *VFP*
          SX7    /CIOERR/BUF *BUFFER ARGUMENT ERROR*
          EQ     /MONITOR/VFP  VERIFY FET PARAMETERS
 
 CPC17    SA2    MB2         GET FET LENGTH - 5 AND RANDOM FLAG
          SA3    A2+B1       GET FUNCTION FLAGS
          BX7    X1+X2
          SA6    A2-B1       SAVE IN AND OUT
          LX3    59-55       CHECK FOR REWIND OPERATION
          SA7    A2          SAVE FIRST, LIMIT, AND FET LENGTH
          SX2    B1
          PL     X3,CPC18    IF NOT REWIND OPERATION
          SX7    B4+         FIRST
          IX1    X5+X2       FET+2
          EWX7   X1          SET IN = FIRST
          IX1    X1+X2       FET+3
          EWX7   X1          SET OUT = FIRST
          ZR     X0,CPC18    IF NO FNT ENTRY
          ERX1   X0          GET FST ENTRY
          LX2    11          CLEAR SYSTEM SECTOR PROCESSING BIT
          MX7    12          GET EST ENTRY
          BX7    X7*X1
          LX7    12
          CX4    X7,EST      CONVERT EST ORDINAL TO OFFSET
          TA4    X4+EQDE,EST
          MX7    -11
          LX4    -12
          BX7    -X7*X4
          SB6    X7-2RMT
          ZR     B6,CPC18    IF *MT* EQUIPMENT
          SB6    X7-2RNT
          ZR     B6,CPC18    IF *NT* EQUIPMENT
          BX7    -X2*X1
          EWX7   X0
 
*         VALIDATE SECURITY ACCESS LEVEL OF FILE AND JOB.
 
 CPC18    ZR     X0,CPC18.4  IF NO FNT ENTRY
          TB6    OSSM        GET O/S SECURITY MODE
          ZR     B6,CPC18.4  IF UNSECURED SYSTEM
          GT     B5,B1,CPC18.4  IF NOT READ OR WRITE FUNCTION
          SX2    B1
          SA1    B7+JSCW     GET JOB ACCESS LEVEL
          IX2    X0+X2
          LX1    15
          ERX2   X2          GET FILE ACCESS LEVEL
          MX6    -3
          LX2    -24
          BX7    -X6*X1
          SA4    B7+SEPW     CHECK FOR SSJ=
          BX6    -X6*X2
          IX7    X7-X6
          LX4    59-50
          ZR     X7,CPC18.4  IF JOB AND FILE AT SAME ACCESS LEVEL
          SA3    B7+JCIW     CHECK FOR SUBSYSTEM
          NG     X4,CPC18.4  IF JOB HAS SSJ= PRIVILEGES
          LX3    -24
          MX4    -12
          BX3    -X4*X3
          MX4    57
          SX3    X3-LSSI-1
          PL     X3,CPC18.4  IF SUBSYSTEM
          SX3    B1
          IX3    X0-X3
          EQ     B5,B1,CPC18.1  IF WRITE FUNCTION
          PL     X7,CPC18.4  IF READ FROM FILE AT LOWER LEVEL
          BX1    X4*X1       RAISE JOB LEVEL TO FILE LEVEL
          BX7    X1+X6
          LX7    -15
          SA7    A1
          EQ     CPC18.4     GET DEVICE TYPE
 
 CPC18.1  NG     X7,CPC18.4  IF WRITE TO FILE AT HIGHER LEVEL
          LX1    59-53-15
          ERX3   X3          GET FNT ENTRY
          MX6    -6
          NG     X1,CPC18.4  IF USER ALLOWED TO WRITE TO LOWER LEVEL
          LX3    -6
          BX6    -X6*X3      GET FILE TYPE FROM FNT
          SX6    X6-PMFT
          ERX3   X0          GET EQUIPMENT FROM FST
          SX7    /CIOERR/WDP *WRITEDOWN PROHIBITED.*
          ZR     X6,RPC      IF DIRECT ACCESS PERMANENT FILE
          MX6    -9
          LX3    12
          BX3    -X6*X3
          LX1    53-59+15
          MX6    -3
          BX1    -X6*X1
          ZR     X3,CPC18.3  IF NO EQUIPMENT ASSIGNED
          CX4    X3,EST      CONVERT EST ORDINAL TO OFFSET
          TA3    X4+EQDE,EST GET EST ENTRY
          MX6    -11         GET EQUIPMENT MNEMONIC
          LX6    12
          BX6    -X6*X3
          LX6    -12
          SB6    X6-2RMT
          ZR     B6,RPC      IF TAPE EQUIPMENT
          SB6    X6-2RNT
          ZR     B6,RPC      IF TAPE EQUIPMENT
          SB6    CPC18.2     SET *VAE* RETURN ADDRESS
          EQ     /MONITOR/VAE0  VALIDATE EQUIPMENT ACCESS LEVEL
 
 CPC18.2  SX7    /CIOERR/LNF *ACCESS LEVEL NOT VALID FOR FILE*
          NG     X6,RPC      IF JOB LEVEL NOT VALID FOR EQUIPMENT
 CPC18.3  MX7    57          RAISE FILE TO JOB ACCESS LEVEL
          SX3    B1+
          BX7    X7*X2
          IX3    X0+X3
          BX7    X7+X1
          LX7    24
          EWX7   X3
 
*         GET DEVICE TYPE.
 
 CPC18.4  SA1    TFCP
          MX6    -11
          BX4    X4-X4
          MX3    -12
          ZR     X0,CPC19    IF NO FNT ENTRY
          ERX2   X0
          LX2    12
          BX4    -X3*X2      EST ORDINAL
          ZR     X4,CPC19    IF EQUIPMENT NOT ASSIGNED
          CX3    X4,EST      CONVERT EST ORDINAL TO OFFSET
          TA3    X3+EQDE,EST READ EST ENTRY
          LX3    -12
          BX4    -X6*X3      DEVICE TYPE
          LX3    12
          PL     X3,CPC19    IF NOT MASS STORAGE
          BX2    X3
          LX2    59-53
          NG     X2,CPC20    IF BUFFERED DEVICE
 
*         DETERMINE FUNCTION PROCESSOR.
 
 CPC19    SA1    A1+1
          BX2    -X6*X1
          BX7    X2-X4
          ZR     X7,CPC20    IF EQUIPMENT FOUND
          NZ     X2,CPC19    IF MORE ENTRIES TO CHECK
          NG     X3,CPC20    IF MASS STORAGE EQUIPMENT
          SA1    A1+1        GET ALL OTHER EQUIPMENT ENTRY
 CPC20    BX6    X3
          NG     X3,CPC21    IF MASS STORAGE
          LX6    59-58
 CPC21    ERX2   X5          SET DEVICE TYPE IN FET
          MX7    1
          BX7    -X6*X7      NON-ALLOCATABLE FLAG
          MX6    -48
          LX4    -12
          BX6    -X6*X2
          SA2    MB3         GET FUNCTION FLAGS
          BX7    X7+X4
          LX2    59-53
          BX6    X6+X7
          SX4    B1
          NG     X2,CPC22    IF DEVICE TYPE NOT TO BE RETURNED
          EWX6   X5
          LX6    59-39
          PL     X6,CPC22    IF FILE ACCESS LEVEL NOT TO BE RETURNED
          IX4    X0+X4
          MX6    -3
          ERX4   X4          GET FILE ACCESS LEVEL
          SX7    3
          IX7    X5+X7       GET FET + 4
          LX4    -24
          ERX2   X7
          BX4    -X6*X4
          LX2    -36
          BX2    X6*X2
          BX6    X2+X4       RETURN FILE ACCESS LEVEL IN FET + 4
          LX6    36
          EWX6   X7
 CPC22    SA2    MB3         GET FUNCTION FLAGS
          MX7    2
          LX2    59-58
          BX2    X7*X2
          BX7    X7*X1
          MX6    -4
          BX2    X7*X2
          SA4    MB          GET INTERNAL FUNCTION CODE
          LX1    -12
          LX4    -6
          NZ     X2,TFPJ+/TFPJ/RUD  IF FUNCTION NOT VALID ON EQUIPMENT
          BX2    -X6*X4
          SB3    X2
          SB6    B3+B3
          BX7    X7-X7
          SB6    B6+B6       FUNCTION CODE * 4
          AX1    B6
          BX1    -X6*X1      INDEX INTO *TFPJ* JUMP TABLE
          SB6    X1
          JP     TFPJ+B6     EXIT TO PROCESSOR
 
 
 TFPJ     BSS    0           TABLE OF FUNCTION PROCESSOR JUMPS
          QUAL   TFPJ
 
 IPP      EQU    *-/CPUCIO/TFPJ
          TEQ    (/BUFIO/IPP,BUFIO,/CPUCIO/TFPJ+/TFPJ/IPP)  PSEUDO PP
          BSS    0
 
 OPE      EQU    *-/CPUCIO/TFPJ
          SA1    /CPUCIO/MB2  READ RANDOM FILE FLAG
          EQ     /CPUCIO/OPE  PROCESS OPEN
          BSS    0
 
 RET      EQU    *-/CPUCIO/TFPJ
          NZ     X0,/CPUCIO/RET  FNT/FST PRESENT
          EQ     /CPUCIO/RWF SET CRI AND COMPLETE FET
          BSS    0
 
 PMT      EQU    *-/CPUCIO/TFPJ
          EQ     /CPUCIO/PMT PROCESS MAGNETIC TAPE
          BSS    0
 
 POD      EQU    *-/CPUCIO/TFPJ
          EQ     /CPUCIO/POD PROCESS OPTICAL DISK
          BSS    0
 
 
 RPC      EQU    *-/CPUCIO/TFPJ
          EQ     /CPUCIO/RPC CALL PP CIO
          BSS    0
 
 RWF      EQU    *-/CPUCIO/TFPJ
          EQ     /CPUCIO/RWF PROCESS REWIND FUNCTION
          BSS    0
 
 TIO      EQU    *-/CPUCIO/TFPJ
          PL     X4,/CPUCIO/TIO  IF NOT CONTROL WORDS
          EQ     /CPUCIO/TFPJ+/TFPJ/RUD  CONTROL WORDS NOT VALID
          BSS    0
 
 CCI      EQU    *-/CPUCIO/TFPJ
          SX7    B1+B1       *TAPQ* TABLE OF PP REQUESTS INDEX
          LX7    42-0
          EQ     /CPUCIO/RPC CALL PP CIO
          BSS    0
 
 RUD      EQU    *-/CPUCIO/TFPJ
          SX7    /CIOERR/RUD *REQUEST UNDEFINED ON DEVICE*
          EQ     /CPUCIO/RPC CALL PP CIO
          BSS    0
 
 IEQ      EQU    *-/CPUCIO/TFPJ
          SX7    /CIOERR/IEQ *ILLEGAL EQUIPMENT ON FILE*
          EQ     /CPUCIO/RPC CALL PP CIO
 
 RTE      EQU    *-/CPUCIO/TFPJ
          SX4    1           SET FST STATUS (EQUIVALENT TO TAPE)
          EQ     /CPUCIO/RWF0  PROCESS REWIND FUNCTION FOR *TEEQ*
          BSS    0
 
          QUAL   *
 TFCP     SPACE  4,20
**        TFCP - TABLE OF FUNCTION CODE PROCESSORS.
*
*T        1/S, 1/T, 10/, 36/ TFPJI, 12/ DT
*         DT     DEVICE TYPE (0 = ANY DEVICE).
*         S      IF SET, MASS STORAGE ONLY FUNCTION IS NOT ALLOWED
*                ON THIS EQUIPMENT.
*         T      IF SET, MAGNETIC TAPE ONLY FUNCTION IS NOT
*                ALLOWED ON THIS EQUIPMENT.
*         TFPJI  *TFPJ* TABLE INDICES TO PROCESS *CIO* FUNCTIONS -
*                4/OV,4/EV,4/RT,4/RW,4/CL,4/OP,4/SK,4/WT,4/RD
*         OV     *TFPJ* TABLE INDEX FOR *OVERWRITE* PROCESSOR.
*         EV     *TFPJ* TABLE INDEX FOR *EVICT* PROCESSOR.
*         RT     *TFPJ* TABLE INDEX FOR *RETURN/UNLOAD* PROCESSOR.
*         RW     *TFPJ* TABLE INDEX FOR *REWIND* PROCESSOR.
*         CL     *TFPJ* TABLE INDEX FOR *CLOSE* PROCESSOR.
*         OP     *TFPJ* TABLE INDEX FOR *OPEN* PROCESSOR.
*         SK     *TFPJ* TABLE INDEX FOR *SKIP* PROCESSOR.
*         WT     *TFPJ* TABLE INDEX FOR *WRITE* PROCESSOR.
*         RD     *TFPJ* TABLE INDEX FOR *READ* PROCESSOR.
*
*         NOTE - FUNCTION PROCESSOR JUMP INDEXES MUST BE IN SAME
*                ORDER AS INTERNAL *CIO* FUNCTION CODES.
 
 
          ERRNZ  /CIO/RDF
          ERRNZ  /CIO/WTF-1
          ERRNZ  /CIO/SKP-2
          ERRNZ  /CIO/OPE-3
          ERRNZ  /CIO/CLO-4
          ERRNZ  /CIO/REW-5
          ERRNZ  /CIO/RET-6
          ERRNZ  /CIO/EVI-7
          ERRNZ  /CIO/OVW-10B
 
 
 TFCP     BSS    0
          QUAL    TFPJ
          VFD    1/0,1/1,10/0      BUFFERED MASS STORAGE
          VFD    4/RPC,4/RPC,4/RPC,4/RWF,4/RPC,4/OPE,4/IPP,4/IPP,4/IPP
          VFD    12/3777B
 
*         TABLE SEARCH STARTS HERE FOR ALL BUT BUFFERED MASS STORAGE.
 
          VFD    1/1,1/0,10/0      OPTICAL DISK
          VFD    4/POD,4/POD,4/POD,4/POD,4/POD,4/POD,4/POD,4/POD,4/POD
          VFD    12/2ROD
 
          VFD    1/1,1/0,10/0      7-TRACK TAPE
          VFD    4/RUD,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT
          VFD    12/2RMT
 
          VFD    1/1,1/0,10/0      9-TRACK TAPE
          VFD    4/RUD,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT
          VFD    12/2RNT
 
          VFD    1/1,1/0,10/0      CARTRIDGE TAPE
          VFD    4/RUD,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT
          VFD    12/2RCT
 
          VFD    1/1,1/0,10/0      ACS CARTRIDGE TAPE
          VFD    4/RUD,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT,4/PMT
          VFD    12/2RAT
 
          VFD    1/1,1/1,10/0      *TE* PSEUDO-EQUIPMENT
          VFD    4/RUD,4/RPC,4/RPC,4/RTE,4/RPC,4/RUD,4/RUD,4/RUD,4/RUD
          VFD    12/2RTE
 
          VFD    1/1,1/1,10/0      TERMINAL
          VFD    4/RUD,4/RPC,4/RPC,4/RWF,4/RPC,4/OPE,4/RPC,4/TIO,4/TIO
          VFD    12/2RTT
 
          VFD    1/0,1/1,10/0      NULL EQUIPMENT
          VFD    4/RPC,4/RPC,4/RPC,4/RWF,4/RPC,4/OPE,4/RPC,4/RPC,4/RPC
          VFD    12/2RNE
 
          VFD    1/1,1/1,10/0      COMMUNICATION COUPLER
          VFD    4/RUD,4/CCI,4/CCI,4/CCI,4/CCI,4/CCI,4/CCI,4/CCI,4/CCI
          VFD    12/2RCC
 
          VFD    1/0,1/1,10/0      ALL OTHER MASS STORAGE
          VFD    4/RPC,4/RET,4/RET,4/RWF,4/RPC,4/OPE,4/RPC,4/RPC,4/RPC
          VFD    12/0
 
          VFD    1/1,1/1,10/0      ALL OTHER NON-MASS STORAGE
          VFD    4/IEQ,4/RET,4/RET,4/RWF,4/RPC,4/IEQ,4/IEQ,4/IEQ,4/IEQ
          VFD    12/0
          QUAL   *
 TCIC     SPACE  4,10
**        TCIC - TABLE OF CIO INTERNAL FUNCTION CODES.
*
*         30 BITS PER ENTRY -
*T        12/ IC, 1/E, 1/M, 1/T, 1/F, 1/R, 1/X, 1/D, 11/0
*         IC = INTERNAL CIO CODE (DEFINED IN *COMSCIO*).
*            = 7777B IF ILLEGAL REQUEST CODE.
*         E = 1, IF EXTENDED FUNCTION LEGAL (3XX/6XX CIO CODE).
*         M = 1, IF MASS STORAGE ONLY FUNCTION.
*         T = 1, IF MAGNETIC TAPE ONLY FUNCTION.
*         F = 1, IF FUNCTION REQUIRES FNT ENTRY.
*         R = 1, IF REWIND OPERATION (SET *IN* = *OUT* = *FIRST*).
*         X = 1, IF FUNCTION LEGAL ON EXECUTE ONLY FILE.
*         D = 1, IF FUNCTION DOES NOT RETURN DEVICE TYPE TO FET.
*
*         REFER TO *ICTE* MACRO FOR PARAMETER DESCRIPTION.
 
 
 TCIC     BSS    0
          QUAL   CIO
 
*         THE FOLLOWING TABLE SECTION CONTAINS THE INTERNAL
*         CODES CORRESPONDING TO THE 000XXXX00 AND 110XXXX00
*         BINARY EXTERNAL CIO FUNCTION CODES.
 
  ICTE    RDF,(PRU,VFL,VIO,RFE,XF)          RPHR (000), READEI (600)
  ICTE    WTF,(PRU,VFL,VIO,RFE)             WPHR (004)
  ICTE    RDF,(EOR,VFL,VIO,RFE)             READ (010)
  ICTE    WTF,(EOI,VFL,VIO,RFE)             WRITE(014)
  ICTE    RDF,(EOR,VFL,VIO,SKO,RFE)         READSKP (020)
  ICTE    WTF,(EOR,VFL,VIO,RFE)             WRITER (024)
  ICTE                                      UNUSED (030)
  ICTE    WTF,(EOF,VFL,VIO,RFE)             WRITEF (034)
  ICTE    SKP,(EOR,SKO,BKW,EXF,XF)          BKSP (040), SKIPB (640)
  ICTE    SKP,(PRU,SKO,BKW,EXF)             BKSPRU (044)
  ICTE    REW,(VFL,BKW,IOF,EXF)             REWIND (050)
  ICTE    REW,(VFL,BKW,IOF,EXF)             REWIND (054)
  ICTE    RET,(UNL,EXF,NDT)                 UNLOAD (060)
  ICTE                                      UNUSED (064)
  ICTE    RET,(EXF,NDT)                     RETURN (070)
  ICTE                                      UNUSED (074)
 
*         THE FOLLOWING TABLE SECTION CONTAINS THE INTERNAL
*         CODES CORRESPONDING TO THE 001XXXX00 AND 011XXXX00
*         BINARY EXTERNAL CIO FUNCTION CODES.
 
  ICTE    OPE,(VFL,RFE,XF)                  OPEN READ/REEL NR(100/300)
  ICTE    OPE,(VFL,RFE)                     OPEN WRITENR (104)
  ICTE    OPE,(VFL,MTO)                     POSMF (110)
  ICTE    EVI,(UNL,EXF)                     EVICT (114)
  ICTE    OPE,(VFL,RFE)                     OPEN NR/ALTERNR (120)
  ICTE                                      UNUSED (124)
  ICTE    CLO,(EOR,XF)                      CLOSE(R) NR (130/330)
  ICTE                                      UNUSED (134)
  ICTE    OPE,(VFL,BKW,RFE,XF)              OPEN READ (140)/REEL (340)
  ICTE    OPE,(VFL,BKW,RFE)                 OPEN WRITE (144)
  ICTE    CLO,(VFL,BKW,EOR,XF)              CLOSE(R) REWIND(150/350)
  ICTE                                      UNUSED (154)
  ICTE    OPE,(VFL,BKW,RFE)                 OPEN ALTER (160)
  ICTE                                      UNUSED (164)
  ICTE    CLO,(BKW,EOR,XF)                  CLOSE(R) UNLOAD(170/370)
  ICTE    CLO,(BKW,EOR,XF)                  CLOSE(R) RETURN (174/374)
 
*         THE FOLLOWING TABLE SECTION CONTAINS THE INTERNAL
*         CODES CORRESPONDING TO THE 010XXXX00 BINARY EXTERNAL
*         CIO FUNCTION CODES.
 
  ICTE    RDF,(EOI,VFL,VIO,CRW,RFE)         READCW (200)
  ICTE    WTF,(EOI,VFL,VIO,CRW,RFE)         WRITECW (204)
  ICTE    RDF,(EOR,VFL,VIO,LST,RFE,MSO)     READLS (210)
  ICTE    WTF,(EOI,VFL,VIO,RWO,RFE,MSO)     REWRITE (214)
  ICTE                                      UNUSED (220)
  ICTE    WTF,(EOR,VFL,VIO,RWO,RFE,MSO)     REWRITER(224)
  ICTE    RDF,(PRU,VFL,VIO,LST,RFE,MSO)     RPHRLS (230)
  ICTE    WTF,(EOF,VFL,VIO,RWO,RFE,MSO)     REWRITEF (234)
  ICTE    SKP,(EOR,SKO,EXF)                 SKIPF/SKIPFF/SKIPEI (240)
  ICTE    OVW,(EOI,MSO)                     OVERWRITE (244)
  ICTE    RDF,(EOF,VFL,VIO,RFE)             READNS (250)
  ICTE    OVW,(EOI,MSO,NDT)                 OVERWRITE RETURN (254)
  ICTE    RDF,(EOF,VFL,VIO,NRW,MTO)         READN (260)
  ICTE    WTF,(EOI,VFL,VIO,NRW,MTO)         WRITEN (264)
  ICTE                                      UNUSED (270)
  ICTE                                      UNUSED (274)
 
          QUAL   *
          TITLE  CPUCIO SPECIAL PROCESSORS.
          SPACE  4,10
**        CPUCIO SPECIAL PROCESSORS.
*
*         STANDARD REGISTER DEFINITIONS.
*
*         (B1) = 1.
*         (B2) = USER EXCHANGE PACKAGE AREA.
*         (B7) = CPA.
*         (A0) = CPU NUMBER.
*         (A5) = PP *OR* ADDRESS OR CP RA+1 ADDRESS.
*
*T  IR    18/ *CIO*, 1/A, 5/ CP, 18/ SKIP COUNT, 18/ FET ADDRESS
*
*T  MB    1/S,5/ RF,6/ RC,5/0,1/F,6/ EC,12/ ORD,4/ LV,8/ XC,12/IC
*         S      SET IF *CIO* RESTARTED FROM RECALL STACK
*         RF     RESTART FLAGS = 1/TIF, 1/0, 1/SDT, 1/BDF, 1/DTF.
*                TIF = TRACK INTERLOCK FLAG.
*                SDT = SKIP DATA TRANSFER FLAG.
*                BDF = BUFFERED DEVICE FUNCTION FLAG.
*                DTF = DATA TRANSFERRED FLAG.
*         RC     RECALL STACK REASON CODE.
*         F      CREATE FNT ENTRY FLAG.  IF SET, *1MS* CREATES
*                AN FNT ENTRY AND RESTARTS CPUCIO.
*         EC     ERROR CODE IF NONZERO.
*         ORD    RELATIVE ADDRESS OF FNT ENTRY IN NFL.
*         LV     LEVEL NUMBER (0 - 17B).
*         XC     EXTERNAL *CIO* FUNCTION CODE.
*         IC     INTERNAL *CIO* FUNCTION CODE (SEE *COMSCIO*).
*
*T  MB1   12/ 0, 24/ *IN*, 24/ *OUT*
*
*T  MB2   1/R, 5/0, 6/ FETL, 24/ *FIRST*, 24/ *LIMIT*
*         R      SET IF RANDOM FILE.
*         FETL   FET LENGTH - 5.
*
*         INITIAL ENTRY CONDITIONS.
*
*         (X0) = ABSOLUTE FST ADDRESS, IF NONZERO.
*         (X3) = *EQDE* WORD OF EST ENTRY.
*         (X4) = (MB) LEFT SHIFTED BY -6.
*         (X5) = ABSOLUTE FET+1 ADDRESS.
*         (X6) = -17B.
*         (X7) = 0.
*         (A4) = MB.
*         (B3) = *COMSCIO* INTERNAL FUNCTION CODE (4 BITS).
 CMF      SPACE  4,10
**        CMF - COMPLETE FET.
*
*         EXIT   TO *CPCX*.
 
 
 CMF      SX4    B1          SET FET COMPLETE
          IX5    X5-X4       ADDRESS OF FET+0
          SA1    IR          CLEAR AUTO RECALL BIT
          ERX2   X5          READ FET+0
          BX6    X2+X4
          LX4    41
          BX7    -X4*X1
          EWX6   X5
          SA7    A1
          EQ     CPCX        RETURN
 OPE      SPACE  4,20
**        OPE - PROCESS NON-RANDOM OPEN.
*
*         ENTRY  (X1) = (MB2).
*
*         EXIT   TO *RPC* IF RANDOM REQUEST ON MASS STORAGE.
*                TO *RWF* IF NON-RANDOM AND REWIND REQUEST.
*                TO *CMF* IF NON-RANDOM AND NOT REWIND.
 
 
 OPE      BX6    X3*X1
          NG     X6,RPC      IF RANDOM FILE AND MASS STORAGE
          MX7    18
          SX6    3
          IX2    X5+X6
          ERX1   X2          READ FET+4
          LX7    -24         CLEAR PRU SIZE FIELD
          SX6    B1
          BX1    -X7*X1
          LX6    24          SET PRU SIZE = 100
          BX7    X1+X6
          ERX1   X0          READ FST
          LX4    -5          EXTRACT REWIND BIT
          SX6    B1
          EWX7   X2          STORE FET+4
          BX4    -X4*X6      COMPLEMENT OF REWIND BIT
          LX6    7           CLEAR FILE WRITTEN SINCE LAST OPEN BIT
          BX1    -X6*X1
          LX6    1
          BX1    X1+X6       SET FILE OPENED BIT
          BX6    X1+X4       COMPLETE FST IF NOT REWIND
          EWX6   X0          WRITE FST
          ZR     X4,RWF      IF REWIND
          EQ     CMF         COMPLETE FET
POD       SPACE  4,10
**        POD - PROCESS OPTICAL DISK REQUESTS
*
*         EXIT   TO *RPC* TO INITIATE OPTICAL DISK DRIVER *1OD*
*
 POD      SX7    3           INDEX INTO TABLE(TAPQ) OF PP REQUESTS
          LX7    42-0
          EQ     RPC         ISSUE CALL FOR *1OD*
 PMT      SPACE  4,10
**        PMT - PROCESS MAGNETIC TAPE REQUEST.
*
*         EXIT   TO *CPCX* IF REQUEST TRANSFERRED TO *MAGNET*
*                SUCCESSFULLY.
*                TO *RCR* IF *CIO* REQUEST TO BE PUT IN RECALL.
*
*         ERROR  EXIT TO *RPC* IF ERROR DETECTED.
*
*         CALLS  /MONITOR/RCC1, /MONITOR/RSC, SRC.
 
 
*         CHECK *MAGNET* AVAILABLE.
 
 PMT      SB4    B3-/CIO/RET
          PL     B4,PMT0     IF RETURN/UNLOAD/EVICT FUNCTION
          SX1    B1
          IX1    X0-X1       ABSOLUTE FNT ADDRESS
          ERX1   X1          CHECK IF TAPE ASSIGNED FOR CE DIAGNOSTICS
          LX1    59-17
          SX7    /CIOERR/ASD *ASSIGNED FOR DIAGNOSTICS*
          NG     X1,RPC      IF *CIO* FUNCTION NOT ALLOWED ON TAPE
 PMT0     BX4    X0          SAVE ABSOLUTE FST ADDRESS
          MX0    -12
          SX1    MTSI        *MAGNET* SUBSYSTEM IDENTIFICATION
          SX7    /CIOERR/TNA *TAPES NOT AVAILABLE*
          SB3    PMT1        SET RETURN ADDRESS FOR *RSC*
          EQ     /MONITOR/RSC  GET *MAGNET* RA AND FL
 
 PMT0.1   PL     B4,PMT1.1   IF RETURN/UNLOAD/EVICT FUNCTION
          EQ     RPC         PROCESS ERROR
 
          VFD    12/PMT0.1-PMT1,18/0,12/PMT0.1-PMT1,18/PMV
 
 PMT1     ERX1   X4          GET FST ENTRY
          NO
          LX1    24
          BX2    -X0*X1      UDT ADDRESS
          ZR     X2,PMT0.1   IF NO UDT ADDRESS
          SX7    X2+/MTX/UCIC+1
          IX7    X7-X6
          SX2    X2+/MTX/UFRQ
          IX0    X3+X2       ABSOLUTE *UFRQ* ADDRESS
+         PL     X7,*        IF OUTSIDE *MAGNET*-S FL
          SB6    A2-STSW     SAVE *MAGNET* CPA
          ERX2   X0          CHECK IF I/O REQUEST IN PROGRESS
          LX1    -24
          SX7    /CIOERR/FSQ *I/O SEQUENCE ERROR*
          NG     X2,PMT0.1   IF TAPE LOST BY MAGNET
          NZ     X2,RPC      IF UDT ALREADY BUSY
 PMT1.1   SX7    B0+         INDICATE NO ERROR
          PL     B4,RPC      IF RETURN/UNLOAD/EVICT FUNCTION
 
*         BUILD *MAGNET* PARAMETER WORDS *UFRQ* - *UCIC*.
 
          SA1    MB2         GET FET LENGTH, FIRST, LIMIT
          SA3    B7+FLSW     GET FL
          MX4    12
          BX7    -X4*X1
          LX3    -12
          BX1    X4*X1       FET LENGTH - 5
          SX6    /MTX/UCIC-/MTX/UFRQ
          BX3    X4*X3
          LX1    1
          IX6    X0+X6       *UCIC* ABSOLUTE ADDRESS
          BX7    X7+X3
          SA2    IR          GET *CIO* CALL
          EWX7   X6          WRITE *UCIC*
          AX1    7
          MX6    -18
          SX7    X2          FET ADDRESS
          LX2    -18
          BX7    X7+X1
          BX6    -X6*X2      SKIP COUNT
          AX1    42
          LX6    24
          SB3    X1-10+5
          BX7    X7+X6
          AX1    1
          SA3    MB          GET INTERNAL AND EXTERNAL FUNCTION CODES
          SB5    X1
          MX1    -12
          LX3    -24
          BX1    -X1*X3      FNT ADDRESS
          LX3    12
          SB4    X1          SAVE FNT ADDRESS
          MX1    -8
          BX6    X4*X3       INTERNAL CODE
          LX2    59-41+18
          BX7    X7+X6
          BX1    -X1*X3      EXTERNAL CODE
          LX3    -8
          MX6    -4
          LX1    -11
          BX6    -X6*X3      LEVEL NUMBER
          LX6    32
          MX3    1
          BX1    X6+X1
          BX2    X3*X2       AUTO RECALL FLAG
          BX1    X1+X2
          SA2    A3+B1       GET IN AND OUT
          SX6    X2          OUT
          AX2    24          IN
          LX4    -12
          IX2    X2-X6
          LX3    58-59
          ZR     X2,PMT2     IF BUFFER EMPTY
          BX1    X1+X3
 PMT2     ERX2   X5          GET FET+1
          LX3    47-59-58+59
          BX6    -X3*X2      CLEAR RANDOM FLAG
          MX2    -30
          PL     B3,PMT3     IF FET LENGTH .GE. 10D
          LX3    41-59-47+59
          BX6    -X3*X6      CLEAR EXTENDED LABEL OPTION
 PMT3     BX4    X4*X6       FET OPTIONS
          EWX6   X5
          R=     X3,/MTX/UCIA-/MTX/UFRQ
          BX6    X1+X4
          ZR     B5,PMT4     IF FET LENGTH .LE. 6
          SX1    5
          IX1    X5+X1       FET+6
          ERX1   X1
          BX1    -X2*X1      UNUSED BIT COUNT AND MLRS FIELD
          BX6    X6+X1
 PMT4     SA1    B7+STSW
          SA2    B6+CWQW
          IX4    X0+X3       *UCIA* ABSOLUTE ADDRESS
          IX5    X4+X3       *UCIB* ABSOLUTE ADDRESS
          ERRNZ  /MTX/UCIB-/MTX/UCIA-1
          EWX7   X4          WRITE *UCIA*
          EWX6   X5          WRITE *UCIB*
          SX6    /MTX/CIO
          SX7    B4+         FNT ADDRESS
          LX6    48
          BX6    X6+X7
          SX7    20B
          EWX6   X0          WRITE *UFRQ*
          IX7    X1+X7       INCREMENT TAPE ACTIVITY
          SB3    PMT5        SET RETURN ADDRESS FOR *RCC*
          LX2    59-46
          SA7    A1
          PL     X2,/MONITOR/RCC  IF TO RECALL *MAGNET* CPU
 PMT5     SB5    CPCX        SET EXIT ADDRESS
          JP     SRC         SET *RCLP* IF AUTO-RECALL SPECIFIED
 RWF      SPACE  4,10
**        RWF - REWIND FILE.
*
*         EXIT   TO *CMF*.
 
 
 RWF      SX4    5
 
*         ENTERED HERE FOR *REWIND* ON *TE* FILE.
*         (X4) = DESIRED FST STATUS = 1.
 
 RWF0     ZR     X0,RWF2     IF NO FST ENTRY
          MX6    12
          ERX1   X0          GET FST ENTRY
          LX6    -24
          PL     X3,RWF1     IF NOT MASS STORAGE
          BX2    X6*X1       CURRENT TRACK
          R=     X3,FSMS     SET CURRENT SECTOR = FIRST SECTOR
          ZR     X2,RWF1     IF FILE NOT USED
          BX2    -X6*X1      SET CURRENT TRACK = FIRST TRACK
          LX1    -12
          BX1    X6*X1       FIRST TRACK
          BX1    X2+X1
          LX6    -12
          BX1    -X6*X1      SET CURRENT SECTOR = FIRST SECTOR
          LX3    12
          BX1    X1+X3
 RWF1     MX7    54
          BX6    X7*X1       SET EOR STATUS IN FST
          BX6    X6+X4
          EWX6   X0          SET FILE NOT BUSY
 RWF2     SA2    MB2         GET RANDOM FILE FLAG
          PL     X2,CMF      IF NOT RANDOM FILE, COMPLETE FET
          SX1    B1
          LX1    30
          IX3    X5+X4       FET+6
          ERX2   X3          GET FET+6
          MX7    -30
          BX7    -X7*X2
          BX7    X7+X1
          EWX7   X3
          EQ     CMF         COMPLETE FET
 TIO      SPACE  4,10
**        TIO - TERMINAL I/O.
*
*         EXIT   TO *RPC* TO INITIATE TERMINAL I/O DRIVER *1MI*.
*                TO *RWF* IF WRITE WITH NO DATA.
*                TO *ROC1* TO ROLLOUT DETACHED INTERACTIVE USER JOB
*                REQUESTING I/O.  *RPPM* REQUEST COMPLETED IF PP
*                REQUESTED INTERACTIVE I/O.
*
*         ERROR EXIT TO *RPC* TO INITIATE *1MS*.
 
 
 TIO      SA2    B7+TFSW     CHECK JOB CONNECTION STATUS
          MX1    12
          BX1    X1*X2
          LX1    12
          CX2    X1,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA2    X2+JSNE,EJT GET JOB EJT ENTRY
          LX2    -7
          BX3    -X6*X2
          SX7    /CIOERR/IRQ *ILLEGAL I/O REQUEST ON FILE*
          ERRNZ  NICS        CODE ASSUMES *NICS* = 0
          SX4    X3-DTCS
          SA1    B7+TIOW     CHECK I/O IN PROGRESS
          SA2    B7+TINW
          BX6    X2
          AX6    18
          BX6    X1+X6
          SX6    X6
          ZR     B3,TIO2     IF TERMINAL READ REQUEST
 
*         PROCESS TERMINAL WRITE REQUEST.
 
          ZR     X3,TIO1.1   IF JOB NOT INTERACTIVE
          SA2    A4+B1       READ MB1
          SX7    X2          *OUT*
          AX2    24          *IN*
          BX2    X2-X7
          ZR     X2,RWF      IF WRITE WITH NO DATA
          ZR     X4,TIO3     IF DETACHED JOB
          NZ     X6,TIO6     IF TIOW/TINW BUSY
          SA2    IR
          SX4    X2          FET ADDRESS
          BX6    X1+X4       SET OUTPUT FET POINTER
          SA6    A1+         REWRITE TIOW
 
*         EXIT TO *RPC* TO INITIATE TERMINAL I/O DRIVER *1MI*.
 
 TIO1     ERX3   X0          SET FST NOT BUSY
          SX7    B1
          BX6    X3+X7
          EWX6   X0
          LX7    42          SET *1MI* FAST LOAD TABLE INDEX
          EQ     RPC         REQUEST TERMINAL I/O DRIVER
 
*         PROCESS TERMINAL OUTPUT BY NON-INTERACTIVE JOB.
 
 TIO1.1   ERX3   X0          SET FST NOT BUSY
          SX7    B1
          BX6    X3+X7
          EWX6   X0
          IX6    X5+X7       SET OUT = IN
          ERX3   X6          READ IN
          IX7    X6+X7
          BX6    X3
          EWX6   X7          WRITE OUT
          EQ     CMF         COMPLETE FET
 
*         PROCESS TERMINAL READ REQUEST.
 
 TIO2     ZR     X3,RPC      IF JOB NOT INTERACTIVE
          ZR     X4,TIO3     IF DETACHED JOB
          NZ     X6,TIO6     IF TIOW/TINW BUSY
          SA1    IR          SET INPUT FET ADDRESS
          SX6    X1
          LX6    18
          BX6    X2+X6
          SA6    A2          REWRITE TINW
          EQ     TIO1        INITIATE TERMINAL I/O
 
*         PROCESS DETACHED JOB TERMINATION.
 
 TIO3     SA1    B7+EOJW     JOB TERMINATION OPTIONS
          MX6    -3
          LX1    0-57
          BX1    -X6*X1
          SB4    X1
          SX7    /CIOERR/IRQ *ILLEGAL I/O REQUEST ON FILE*
          NE     B4,B1,RPC   IF DETTACHED JOB TO BE TERMINATED
          ERRNZ  SUJT-1      CODE DEPENDS ON VALUE
          ERX3   X0          SET FST NOT BUSY
          SX7    B1
          BX7    X3+X7
          EWX7   X0
          SB3    TIO4        RETURN ADDRESS FOR *AQR*
          SA1    IR          GET *CIO* CALL TO BE QUEUED
          SX7    DTSR        JOB SUSPENSION REASON CODE
          BX6    X1
          LX7    -12
          SA7    /MONITOR/AQRA  SET PARAMETER WORD FOR *AQR*
          EQ     /MONITOR/REC2  QUEUE *CIO* REQUEST
 
*         ASSURE DROP OPTION ON *RPPM* FUNCTION REQUEST.
 
 TIO4     TX1    10B,SP
          MX0    -18
          SX2    A5
          BX2    -X0*X2
          IX1    X2-X1
          SX5    B1+
          ERRNZ  ROSU-10B    CHECK *ROCM* SUSPENSION POSITION
          LX5    39-0+12
          SB6    -1          INDICATE *CPUCIO* CALL TO *ROCM*, *DCPM*
          BX2    X2-X2       REQUIRED BY *ROCM*
          PL     X1,/MONITOR/ROC4  IF NOT *RPPM* REQUEST
          SX7    B1
          SA1    A5          SELECT DROP OPTION ON *RPPM* REQUEST
          LX7    36          *RPPM* COMPLETION STATUS
          LX1    59-37
          PL     X1,TIO5     IF NO DROP OPTION SELECTED
          SX7    4000B+DPPM  FORCE *DPPM* FUNCTION REQUEST
          LX7    48
 TIO5     SA7    A5          REWRITE OUTPUT REGISTER
          EQ     /MONITOR/ROC4  ROLLOUT JOB
 
 TIO6     SA1    IR          SET TIOW/TINW BUSY IN REQUEST
          SX7    B1
          LX7    35-0
          BX7    X1+X7
          SA7    A1          REWRITE INPUT REGISTER
          EQ     TIO1        START UP *1MI*
 
          ENDBLK
          BLOCK  MCE,(MEMORY CLEARING ROUTINES.)
 MCE      SPACE  4,10
**        THIS BLOCK IS LOADED IF THE MEMORY CLEARING OPTION
*         IS ENABLED IN THE IPRDECK.  THE BASIC PURPOSE IS TO
*         CLEAR STORAGE UPON RELEASE IN ADDITION TO UPON ASSIGMENT.
 CST      SPACE  4,20
**        CST - EXCEPTION PROCESSOR FOR SPECIAL MEMORY CLEAR REQUEST.
*
*         THIS ROUTINE IS CALLED TO BUILD THE *CSTM* REQUEST FROM THE
*         *RSTM* REQUEST THAT IS STORED IN MB+5.
*
*         ENTRY  (MB+5) = 12/ RSTM, 12/ NEW FL, 3/,1/NFL REQUEST
*                         7/,1/ ECS REQUEST, 24/
*
*         EXIT   TO /MONITOR/CST0 WITH REBUILT REQUEST -
*                (X5) = 12/ CSTM, 4/1, 1/ECS REQUEST, 1/1,
*                       18/ WORD COUNT, 24/ FWA
*
*         USES   X - ALL.
*                A - 1, 2, 3.
*                B - 3.
*
*         CALLS  /CME/CSM, /0CME/CSM.
 
 
 CST      SA2    A5+6        GET *MB+5*
          SA3    B7+ECSW     GET ECS FL CONTROL
          MX0    -12
          MX5    1
          LX2    59-24
          BX1    X5*X2       EXTRACT ECS REQUEST FLAG
          NG     X2,CST1     IF CLEARING ECS FL
          SA3    B7+FLSW     GET CM FL CONTROL
          LX2    59-32-59+24
          NG     X2,CST4     IF CLEARING NFL
          LX2    59-24-59+32
 CST1     LX2    24-59+24
          BX6    -X0*X2      NEW FL
          BX4    -X0*X3      OLD FL
          IX4    X4-X6       WORD COUNT
 CST2     LX4    24
          LX1    43-59
          LX5    42-59
          BX6    X4+X6       START BUILDING REQUEST
          BX5    X1+X5
          NZ     X1,CST3     IF ECS FL
          LX6    6           MULTIPLY REQUEST BY 100B
 CST3     BX1    X5+X6       SET RELATIVE/ECS REQUEST FLAG(S)
          SX6    CSTM*100B+4B  SET UP FOR RE-ENTRY
          LX6    -18
          BX5    X6+X1
          BX1    X5
          EQ     /MONITOR/CST0  RESTART *CSTM* PROCESSOR
 
 CST4     LX2    32-59+24
          LX3    12
          BX4    -X0*X2      NEW NFL
          BX6    -X0*X3      OLD NFL
          IX4    X6-X4       WORD COUNT
          BX6    -X6         COMPLEMENT FWA
          LX6    6
          MX3    -24
          BX6    -X3*X6
          LX6    -6
          EQ     CST2        COMPLETE BUILDING OF REQUEST
 
 CST5     LX4    59-44-59+42
          NO
          TPL    X4,(/CME/CSM,CME,/0CME/CSM)  IF NOT SPECIAL REQUEST
          SB3    /MCE/CST6   *CSM* RETURN ADDRESS
          TEQ    (/CME/CSM,CME,/0CME/CSM)  CLEAR STORAGE
 
 CST6     SA1    A5+6        GET *RSTM* REQUEST
          SX7    B1
          LX7    29
          BX7    X7+X1       SET COMPLETION BIT
          EQ     /MONITOR/PPR1  EXIT
 CST      SPACE  4,15
**        CSTX - EXIT PROCESSOR FOR PROGRAM MODE *CSTM*.
*
*         THIS PROCESSOR IS CALLED TO CHECK SPECIFICATION OF THE
*         SPECIAL REQUEST OPTION TO DETERMINE IF THE *RSTM* REQUEST
*         THAT MIGHT BE IN *MB+5* MUST BE RESTORED.
*
*         ENTRY  (X7) = 0.
*
*         EXIT   TO /PROGRAM/PRG1
*
*         USES   X - 3, 7.
*                A - 3.
 
 
 CSTX     SA3    A5          CHECK REQUEST OPTION(S)
          LX3    59-44
          PL     X3,/PROGRAM/PRG1  IF NOT SPECIAL REQUEST
          SA3    A5+6        GET MB+5
          SX7    B1
          LX7    29
          BX7    X7+X3       SET REQUEST COMPLETED
          EQ     /PROGRAM/PRG1  EXIT
 CUE      SPACE  4,15
**        CUE - CLEAR USER ECS.
*
*         THIS ROUTINE IS CALLED TO CLEAR USER ECS IN ORDER
*         TO MAINTAIN SECURED MEMORY (MEMORY CLEARING ENABLED).
*
*         ENTRY  (X1) = WORD COUNT.
*                (X2) = ABSOLUTE FWA.
*                (B3) = RETURN ADDRESS.
*
*         USES   X - 0, 1, 4, 6.
*                A - 0, 4.
*                B - 4.
 
 
 CUE      TSX0   (LCCB-1,CP176,1-1)
          SAC    18,CCMB     ADD CLEAR CENTRAL MEMORY BUFFER
          NZ     X0,CUE1     IF NOT CYBER 990 TYPE MAINFRAME
          SA4    ECRL        GET RAE FOR ZERO UEM BLOCK
          LX4    0-12
          MX0    -24
          BX0    -X0*X4
          TLX0   9-21+60,UESC
 CUE1     SA0    /PROGRAM/UBUF  SET FWA OF CM BUFFER
          TLX0   (0,CP176,21)
          SB4    /PROGRAM/MECB  SET WORD COUNT
          TLX0   (3,ESM170,0)
          SX6    A0
          TLX0   (4,UEM180,0)
          LX6    30
          BX0    X0+X6
+         RE     B4          CLEAR CM BUFFER
 
*         NOTE - HALF EXIT WILL BE TAKEN ON EXTENDED MEMORY READ
*                BECAUSE OF OUT-OF-RANGE ADDRESS SPECIFIED TO CAUSE
*                ZEROES TRANSFER TO CM.
 
          SB0    0           (HALF-EXIT EXPECTED)
          BX0    X6+X2       ECS ADDRESS
          SX4    B4+         ADDRESS INCREMENT/DECREMENT
 CUE2     WUE    PROGRAM     CLEAR USER EM
*         SB0    0           (IGNORE HALF-EXIT)
+         IX1    X1-X4       DECREMENT WORD COUNT
          IX0    X0+X4       INCREMENT ECS ADDRESS
          NZ     X1,CUE2     IF NOT COMPLETE
          JP     B3          RETURN
 MEC      SPACE  4,15
**        MEC - EXTENSION FOR USER ECS STORAGE MOVE.
*
*         THIS PROCESSOR DETERMINES IF VACATED EXTENDED MEMORY FIELD
*         LENGTH MUST BE CLEARED FOLLOWING A STORAGE MOVE.
*
*         ENTRY  (B7) = CP/PCP ADDRESS.
*
*         EXIT   TO /PROGRAM/MEC2.1
*
*         USES   X - 0, 1, 2, 3, 4.
*                A - 1, 2, 3.
*                B - 3.
*
*         CALLS  CUE.
 
 
 MEC      TSA3   (UEML,UEM,ZERL)
          SA1    SMRL
          SA2    B7+ECSW
          SB3    /PROGRAM/MEC2.1  *CUE* RETURN ADDRESS
          TX0    B7+CPAS,-SCA
          MX4    -12
          LX3    12
          BX3    -X4*X3      UEM BASE ADDRESS IF UEM PRESENT
          LX4    24
          BX4    -X4*X1      DIRECT MOVE HOLE POINTER
          NZ     X0,MEC1     IF NOT LAST CONTROL POINT
          PL     X1,MEC2     IF UPWARD MOVE
 MEC1     ZR     X4,/PROGRAM/MEC2.1  IF NOT DIRECT MOVE
          BX1    X2
          LX1    48          WORD COUNT = FLE
 MEC2     AX2    RSHF
          MX0    -RMSK
          AX1    48
          BX2    -X0*X2
          LX3    9
          TLX2   9,UESC
          TLX1   9,UESC      WORD COUNT
          IX2    X2+X3       OLD RA = FWA
          EQ     CUE         CLEAR USER ECS
 MST      SPACE  4,15
**        MST - EXTENSION FOR MEMORY CLEARING AFTER STORAGE MOVE.
*
*         THIS PROCESSOR DETERMINES IF VACATED FIELD LENGTH MUST BE
*         CLEARED FOLLOWING A STORAGE MOVE.
*
*         ENTRY  (B7) = CP/PCP ADDRESS.
*
*         EXIT   TO /PROGRAM/MST3.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2.
*                B - 3.
*
*         CALLS  /CME/CSM, /0CME/CSM.
 
 
 MST      SA2    B7+FLSW
          SA1    SMRL
          SB3    MST2        *CSM* RETURN ADDRESS
          SX6    B7-CPAS
          TX7    B7+CPAS,-SCA
          MX4    -12
          BX3    -X4*X2      FL
          LX4    24
          ZR     X6,MST1     IF CP 1 MOVING
          BX4    -X4*X1      DIRECT MOVE HOLE POINTER
          NZ     X7,MST0.1   IF NOT LAST CP MOVING
          PL     X1,MST0.2   IF UPWARD MOVE
 MST0.1   ZR     X4,MST2     IF NOT DIRECT MOVE
          LX3    48
          IX1    X2+X3       WORD COUNT = (FL + NFL)
 MST0.2   AX1    48
          AX2    RSHF
          MX0    -RMSK
          LX1    6
          BX3    -X0*X2      RA/100B
          AX2    48-RSHF     NFL/100B
          IX2    X3-X2
          LX2    6           FWA TO CLEAR (RA - NFL)
          TEQ    (/CME/CSM,CME,/0CME/CSM)  CLEAR STORAGE
 
 MST1     PL     X1,MST2     IF NOT DOWNWARD MOVE
          AX1    48
          AX2    RSHF
          LX1    6
          MX0    -RMSK
          BX1    -X1         WORD COUNT
          BX2    -X0*X2      RA/100B
          IX2    X2+X3       (LWA+1)/100B
          LX2    6
          IX2    X2-X1       (LWA+1) - WORD COUNT
          TEQ    (/CME/CSM,CME,/0CME/CSM)  CLEAR STORAGE
 
 MST2     TA1    CMMS,SDA    PRESET MOVE COUNT FOR REENTRY
          EQ     /PROGRAM/MST3  COMPLETE STORAGE MOVE
 PRS      SPACE  4,20
**        PRS - PRESET EXTENSION TO CLEAR MEMORY AT DEADSTART.
*
*         THIS ROUTINE IS CALLED TO CLEAR ALL UNASSIGNED FIELD LENGTH
*         DURING DEADSTART IF MEMORY CLEARING IS ENABLED.
*
*         ENTRY  (PRSA) = RECOVERY LEVEL.
*                (A0) = LWA+1 OF *CPUMTR*.
*
*         EXIT   (0) = LWA+1 OF *CPUMTR* (TO BE PICKED UP BY *STL*).
*                TO *CPSL* (IN LOW CORE).
*
*         USES   X - 0, 1, 2, 3, 4, 6.
*                A - 0, 1, 2, 3, 4, 6.
*                B - 3, 7.
*
*         CALLS  /CME/CSM, /0CME/CSM, /MCE/CUE.
 
 
 PRS      SA2    PRSA        GET RECOVERY LEVEL
          SX6    A0+77B      LWA+1 OF *CPUMTR* (FWA TO CLEAR)
          SA1    1*200B+FLSW
          AX6    6
          SX2    X2-3
          NZ     X2,PRS1     IF NOT LEVEL 3 RECOVERY
          MX0    -12
          BX6    -X0*X1      FL/100B
          AX1    RSHF
          MX0    -RMSK
          BX1    -X0*X1
          IX6    X1+X6       RA + FL
 PRS1     SA6    PRSB        START ADDRESS
          SB3    PRS3        *CSM* RETURN ADDRESS
 PRS2     SA1    A1+200B     NEXT CONTROL POINT
          SA2    PRSB        CURRENT ADDRESS
          MX0    -RMSK
          AX1    RSHF
          BX4    -X0*X1      RA/100B
          AX1    48-RSHF     NFL/100B
          IX4    X4-X1       FWA OF USER FL (RA - NFL)
          IX1    X4-X2       WORD COUNT
          LX2    6
          LX1    6
          ZR     X1,PRS3     IF NO MEMORY TO CLEAR
          TPL    X1,(/CME/CSM,CME,/0CME/CSM)  IF NO OVERLAP
          EQ     PRS4        BYPASS UPDATE OF CURRENT ADDRESS
 
 PRS3     SA1    A1          FIELD LENGTH CONTROL
          MX0    -12
          BX3    -X0*X1      FL/100B
          AX1    RSHF
          MX0    -RMSK
          BX1    -X0*X1      RA/100B
          IX6    X1+X3
          SA6    A2          UPDATE CURRENT ADDRESS
 PRS4     SX1    A1+
          TX1    X1-FLSW,-SCA
          NZ     X1,PRS2     IF NOT LAST USER CONTROL POINT
          TEQ    (/MCE/PRS5,UEC,/MCE/PRS9)  PROCESS USER ECS
 
 PRS5     SA2    PRSA
          SA1    1*200B+ECSW
          SB7    A0          SAVE (A0)
          MX0    -12
          SX3    X2-3
          NZ     X3,PRS9     IF NOT LEVEL 3 RECOVERY
          BX2    -X0*X1      FL/*UEBS*
          AX1    RSHF
          MX0    -RMSK
          BX1    -X0*X1      RA/*UEBS*
          IX6    X2+X1
          SA6    PRSB        START ADDRESS
          SB3    PRS7        *CUE* RETURN ADDRESS
 PRS6     SA1    A1+200B     NEXT CONTROL POINT
          SA2    PRSB        CURRENT ADDRESS
          MX0    -RMSK
          AX1    RSHF
          BX4    -X0*X1      RA/*UEBS*
          IX1    X4-X2       WORD COUNT
          TSA3   (UEML,UEM,ZERL)
          MX0    -12
          AX3    48
          BX3    -X0*X3      UEM BASE ADDRESS IF UEM PRESENT
          LX3    9
          TLX2   9,UESC
          IX2    X2+X3
          TLX1   9,UESC
          ZR     X1,PRS7     IF NO MEMORY TO CLEAR
          PL     X1,CUE      IF NO OVERLAP
          EQ     PRS8        BYPASS UPDATE OF CURRENT ADDRESS
 
 PRS7     SA1    A1          FIELD LENGTH CONTROL
          MX0    -12
          BX3    -X0*X1      FL/1000B
          AX1    RSHF
          MX0    -RMSK
          BX1    -X0*X1      RA/1000B
          IX6    X1+X3
          SA6    A2          UPDATE CURRENT ADDRESS
 PRS8     SX1    A1+
          TX1    X1-ECSW,-SCA
          NZ     X1,PRS6     IF NOT LAST CONTROL POINT
          SA0    B7+         RESTORE (A0)
 PRS9     SX6    A0          SET LWA+1 OF *CPUMTR*
          SA6    B0
          EQ     CPSL        BRANCH TO STOP
 
 
 PRSA     BSS    1           RECOVERY LEVEL
 PRSB     BSS    1           CURRENT ADDRESS
 
          ENDBLK
          BLOCK  NVE,(NVE ROUTINES.)
          SPACE  4,10
 MT       EQU    /MONITOR/MT
 XJ1      SPACE  4,15
**        XJ1 - EXCHANGE PROCESSOR.
*
*         ENTRY  (B2) = EXCHANGE PACKAGE ADDRESS.
*
*         EXIT   (X0) .LT. 0 IF EXCHANGE NEEDED.
*                TO */CME/XJ3* TO EXCHANGE TO PROGRAM.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 3.
 
 
 XJ1      BSS    0           ENTRY
          SB3    A0+
          NZ     B3,/CME/XJ3 IF SECOND CPU
          TB3    A0,DSCB
          SA1    B3+/DST/D7JP  JOB PRIORITY
          SA2    B3+/DST/D8JP  TASK PRIORITY
          MX7    -16
          BX6    X6-X6
          ZR     X2,/CME/XJ3 IF NO TASK PRESENT
          BX1    -X7*X1
          SA6    /MONITOR/IP CLEAR PRIORITY INCREASE
          RC     X6          READ MICROSECOND COUNTER
          AX6    14
          BX2    -X7*X2
          MX7    -4
          BX6    -X7*X6      EXTRACT SUB-PRIORITY
          BX1    X1+X6
          IX7    X1-X2       COMPARE PRIORITIES
          PL     X7,/CME/XJ3 IF NO EXCHANGE NEEDED
          AX2    8
          ZR     X2,/CME/XJ3 IF NO EXCHANGE NEEDED
          SA1    PPXL
          ZR     X1,XJ11     IF NO PP EXCHANGE REQUESTED/PENDING
          SA1    XJ1A        RESIDUAL COUNTDOWN
          NZ     X1,XJ12     IF NOS/VE BYPASS LIMIT NOT REACHED
          SA2    VEBL        NOS/VE BYPASS LIMIT
          MX6    -12
          BX6    -X6*X2
          SA6    A1          INITIALIZE COUNTDOWN
 XJ11     MX0    1
          JP     /CME/XJ3    EXCHANGE
 
 XJ12     SX6    X1-1        DECREMENT COUNTDOWN
          SA6    A1
          JP     /CME/XJ3    NO EXCHANGE TO NOS/VE FOR NOW
 
 XJ1A     CON    0           NOS/VE BYPASS COUNTDOWN
 SVS      SPACE  4,15
**        SVS - SET SCHEDULING DATA.
*
*         ENTERED AT *SVS1* FROM */MONITOR/SPR*.
*
*         EXIT   WORD *D7JP* IN *DSCB* SET UP.
*                24/ JSN,12/ EJT ORDINAL,8/ TRAP VALIDATION,16/PRIORITY
*                (*MLST*) MOVED TO *NVE* BUFFER IF DATA TO BE MOVED.
*
*         USES   X - 0, 2, 4, 5, 6, 7.
*                A - 2, 4, 6, 7.
*                B - 3, 4, 5, 6.
 
          SYSCOM
 
 SVS      BSS    0           ENTRY
          SA4    B2+CWQW     GET CPU PRIORITY
          SB6    /MONITOR/BNJ20  SET *BNJ* RETURN ADDRESS
          UX4,B5 X4          UNPACK CPU PRIORITY AND FLAGS
          SX5    B5+         SET CPU PRIORITY
          MX0    -12
 
*         ENTRY FROM */MONITOR/SPR*.
*         (B6) = RETURN ADDRESS.
*         (X5 BITS 3 - 9) = CPU PRIORITY.
*         (X0) = 77...770000B.
 
 SVS1     BSS    0           ENTRY
          SB3    A0+
          NZ     B3,/MONITOR/RB6  IF SECOND CPU
          TB3    A0,DSCB
          SA2    /MONITOR/IP SUB-PRIORITY
          SA4    B7+JCIW     GET SUBSYSTEM ID
          SX6    X2+
          AX4    24-0
          SA2    SSTL
          BX7    -X0*X4
          SX7    X7-NVSI     NVE SUBSYSTEM ID
          MX0    3
          LX2    59-44
          ZR     X7,SVS2     IF NVE SUBSYSTEM
          NG     X2,SVS4     IF HARDWARE FAULT INJECTION IS DISABLED
 SVS2     LX0    16-57       SET *V1*, *V2*, AND *V3* BITS
          BX6    X0+X6
          NZ     X7,SVS4     IF NOT NVE SUBSYSTEM
          TA2    NVESS       *SSCT* WORD CONTAINING *NVE* BYTE
          TLX2   0,NVEOS
          PL     X2,SVS4     IF *NVE* NOT YET ACTIVATED
          SA2    B3+/DST/D7ST  GET POINTER TO *MLST*
          MX0    -18
          LX2    -18
          BX7    -X0*X2      *MLST* ADDRESS
          ZR     X7,SVS4     IF NO *MLST*
          SA4    X7          PICK UP THE FLAG/COUNT WORD
          ZR     X4,SVS4     IF NO ACTIVE ENTRIES IN *MLST*
          SX0    MLBR        *NVE* BUFFER POINTER
          SA2    B2+B1       GET RA FROM EXCHANGE PACKAGE
          AX2    36-0
          IX0    X0+X2
          ERX2   X0          PICK UP MESSAGE LINK BUFFER POINTER
          MX0    -18
          BX0    -X0*X2
          ZR     X0,SVS4     IF NO BUFFER ADDRESS
          SX7    X4+B1       TOTAL WORDS TO TRANSFER
          SA2    B2+2        GET FLC FROM EXCHANGE PACKAGE
          AX2    36-0
          IX2    X2-X7       SUBTRACT OUT TRANSFER WORD COUNT
          IX2    X2-X0       SUBTRACT OUT BUFFER ADDRESS
          NG     X2,SVS4     IF BUFFER EXTENDS BEYOND FL
          SA2    B2+B1       GET RA AGAIN
          SB4    X7          WORDS TO TRANSFER
          AX2    36-0
          BX7    X4
          IX0    X0+X2       ABSOLUTE BUFFER ADDRESS
          EWX7   X0          ACTIVE WORD COUNT TO FIRST WORD OF BUFFER
          BX7    X7-X7
          SA7    A4          CLEAR ACTIVE WORD COUNT
 SVS3     SB4    B4-B1       DECREMENT LOOP COUNTER
          SA2    B4+A4       GET WORD FROM *MLST*
          BX7    X2
          SX2    B4
          IX2    X2+X0
          EWX7   X2          STORE WORD IN *NVE* BUFFER
          GT     B4,B1,SVS3  IF MORE ACTIVE WORDS TO MOVE
 SVS4     SA2    B7+SSCW     CHECK FOR *NVE* CONNECTION
          SB5    X5-IDCS*10B-10B
          NG     B5,SVS8     IF IDLE PACKAGE
          AX5    6           FORM NORMALIZED PRIORITY
          MX0    -12
 SVS5     ZR     X2,SVS6     IF NO CONNECTIONS
          BX7    -X0*X2      CHECK NEXT BYTE
          BX2    X0*X2
          LX7    -6
          SX7    X7+LSSI-NVSI
          LX2    12
          NZ     X7,SVS5     IF JOB NOT CONNECTED TO *NVE*
          SX2    B1          SET *V3* VALIDATION BIT
          LX2    18-0
 SVS6     SX7    X5-MPRS/10B
          LX5    8
          BX6    X6+X2       ADD VALIDATION BIT
          BX6    X6+X5       ADD PRIORITY
          ZR     X7,SVS8     IF SYSTEM CP OR STORAGE MOVE PACKAGE
          NZ     X5,SVS7     IF NOT MAINTENANCE JOB
          SX4    1S8         SET PRIORITY OF 1
          BX6    X6+X4
 SVS7     SA2    B7+TFSW     FORM UNIQUE ID FROM JSN AND EJT ORDINAL
          AX2    48
          MX7    -12
          BX7    -X7*X2
          BX2    X7
          LX7    -36
          BX6    X7+X6       ADD EJT ORDINAL
          CX4    X2,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA4    X4+JSNE,EJT READ EJT
          MX0    6*4
          BX4    X0*X4
          BX6    X4+X6       ADD JSN
 SVS8     SA6    B3+/DST/D7JP  WRITE *D7JP* WORD
          JP     B6          RETURN
 CPT      SPACE  4,15
**        CPT - EXTENSION FOR *NVE*.
*
*         ENTRY  (B3) = EXIT ADDRESS.
*                (B6) = 200B IF ENTERED AT *CPT1* (*BNJ* CALL).
*
*         EXIT   TO /MONITOR/CPT1.
*                TO /CME/CPT1 IF SECOND CPU.
*                (X0) = CPU TIME INCREMENT IN MACHINE UNITS.
*                (MT+A0) = 0 IF RA+1 PROCESS AND NOT CPU SWITCH.
*                (MT+A0) = -ACAD2 IF NOT RA+1 PROCESS OR IF CPU SWICH.
*                (CL+CPBT+A0) RESET TO CURRENT CLOCK.
*                (CL+CMST+A0) UPDATED.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 3, 6, 7.
*                B - 4, 6.
 
 
 CPT      BSS    0           ENTRY
          SB6    B0+         DO NOT SET CPU SWITCH FLAG
 
*         ENTRY FROM /MONITOR/*BNJ*.
 
 CPT1     BSS    0           ENTRY
          SX1    A0+
          NZ     X1,/CME/CPT1  IF SECOND CPU
          SA1    CL+CMST+A0  GET MONITOR MODE PARAMETERS
          SA3    MT+A0       GET MONITOR MODE ACCUMULATED TIME
          RT     X0,40B      READ AND CLEAR PIT
          RC     X6          READ CLOCK
          UX1,B4 X1
          SB6    B4+B6       SET CPU SWITCH STATUS
          PX7    B6,X6       SET FUNCTION WITH STATUS AND NEW BASE TIME
          SA7    A1          UPDATE MONITOR MODE STATUS
          SX7    B0          SET TO CLEAR MONITOR MODE ACCUMULATOR
          ZR     B6,CPT3     IF RA+1 PROCESS AND NOT CPU SWITCH
          ERRNZ  CCPF        CODE DEPENDS ON VALUE
          TX7    -ACAD2      - (EXCHANGE JUMP TIME)
          ZR     B4,CPT3     IF RA+1 PROCESS
 
*         COMPUTE MONITOR MODE TIME SINCE LAST BASE TIME.
 
          PL     X3,CPT2     IF *MT* NOT PREVIOUSLY ADJUSTED BY *CPT*
          SX3    B0+
 CPT2     IX5    X6-X1       MONITOR MODE TIME INCREMENT
          IX3    X3+X5       ADD INCREMENT TO ACCUMULATED TIME
          IX3    X3-X7       ADD EXCHANGE JUMP TIME
 
*         COMPUTE PROGRAM MODE CPU TIME USED.
*
*         IF MONITOR MODE WAS NOT ENTERED TO PROCESS AN RA+1 CALL OR IF
*         A CPU SWITCH IS PENDING, THE MONITOR MODE ACCUMULATOR FOR THE
*         CPU WILL BE RESET WITH A VALUE OF *-ACAD2*.  SINCE EXIT FROM
*         MONITOR MODE ADDS AN INCREMENT OF *ACAD* (TWICE THE VALUE OF
*         *ACAD2*) TO THE ACCUMULATOR, THE RESULT IN THIS CASE WILL BE
*         TO ACCOUNT ONLY FOR THE EXCHANGE JUMP BACK TO PROGRAM MODE.
*         *CPT* WILL ALREADY HAVE ACCOUNTED FOR THE EXCHANGE JUMP INTO
*         MONITOR MODE.
 
 CPT3     MX2    28
          SA7    A3          RESET MONITOR MODE ACCUMULATOR
          BX0    -X2-X0      170 MODE TIME USED
          IX0    X0-X3       DEDUCT MONITOR MODE TIME
          SA6    CL+CPBT+A0  RESET PROGRAM MODE BASE TIME
          PL     X0,/MONITOR/CPT1  IF NO UNDERFLOW ON ADJUSTMENT
          SX0    B0
          EQ     /MONITOR/CPT1  ENTER MAIN *CPT* PROCESSOR
 AVP      SPACE  4,15
**        AVP - ASSIGN VIRTUAL PP.
*
*         ENTRY  (X6) = PP CALL.
*                (B4) = -1 (PRIORITY PP REQUEST).
*
*         EXIT   TWO COPIES OF *1VP* ARE ASSIGNED.  THESE MUST BE IN
*                PARTNER PP-S.  IF NO SUCH PAIR IS AVAILABLE, THEN NO
*                ASSIGNMENT IS MADE.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 3, 5.
*
*         CALLS  APQ.
 
 
 AVP      SA2    PPAL        DETERMINE IF A PARTNER PAIR IS FREE
          SB5    7
          SX4    B1          INITIALIZE MASK
          BX7    X4
          LX4    45-0        FIRST BANK = PP 2
          LX7    30-0        SECOND BANK = PP 22
 AVP1     BX3    X4+X7
          BX1    X3*X2
          BX1    X1-X3
          SB5    B5-B1
          ZR     X1,AVP3     IF PAIR IS AVAILABLE
          LX4    -1          ADVANCE FIRST BANK PP
          LX7    1           ADVANCE SECOND BANK PP
          PL     B5,AVP1     IF MORE PP-S TO CHECK
          SX7    B0+
          EQ     /MONITOR/PPR1  SET REPLY
 
 AVP3     SB3    AVP4        *APQ* RETURN ADDRESS
          SA7    /MONITOR/APQC   SET PP TO SELECT
          BX7    X4          SAVE PARTNER PP MASK
          SA7    AVPA
          MX4    5           ADD CONTROL POINT TO PP CALL
          LX4    40-59
          SX7    B7
          LX7    36-7
          BX6    -X4*X6
          BX6    X7+X6
          SA6    AVPB        SAVE PP CALL FOR SECOND ASSIGNMENT
          EQ     /MONITOR/APQ1.1  ASSIGN FIRST PP
 
 AVP4     BX7    X7-X7
          NG     X1,/MONITOR/PPR1  IF LIBRARY LOCKED
          BX7    X1
          SA7    AVPC        SAVE INPUT REGISTER ADDRESS
          SA1    AVPB        GET PP CALL
          BX6    X1
          SA2    AVPA        GET SECOND PP SELECTION MASK
          BX7    X2
          SA7    /MONITOR/APQC
          SB3    AVP5        *APQ* RETURN ADDRESS
          SB4    -1
          EQ     /MONITOR/APQ1.1  ASSIGN SECOND PP
 
 AVP5     LX1    24          POSITION SECOND *IR* ADDRESS
          SA2    AVPC        ADD FIRST *IR* ADDRESS
          LX2    36
          BX7    X1+X2
          EQ     /MONITOR/PPR1  STORE OUTPUT REGISTER
 
 
 AVPA     CON    0           SECOND PP SELECTION MASK
 AVPB     CON    0           PP CALL
 AVPC     CON    0           FIRST PP INPUT REGISTER ADDRESS
 UAD      SPACE  4,10
**        UAD - *UADM* EXTENSION FOR *FRAS* SUBFUNCTION.
*
*         ENTRY  (X0) = MASK(48).
*                (X2) = 12/ FRAS, 48/ DESIRED *FRC* VALUE.
*
*         EXIT   (MS, ST - ST+1) UPDATED.
*                (/CME/RTCA - /CME/RTCC) UPDATED.
 
 
 UAD      MX6    0           RELEASE *1MB* TO NOTIFY *DFT* OF REQUEST
          LX0    -12
          SA6    A5+
          BX7    X0*X2       EXTRACT DESIRED *FRC* VALUE
          BX4    X4-X4
          RC     X5          READ CURRENT *FRC* VALUE
          IX2    X7-X5       CALCULATE *FRC* INCREMENT
 
*         WAIT FOR *FRC* TO BE ADVANCED BY *DFT*.
 
 UAD1     RC     X3          READ CURRENT *FRC* VALUE
          IX1    X3-X7
          NG     X1,UAD1     IF *FRC* UPDATE HAS NOT OCCURRED YET
 
*         ADJUST *FRC*-BASED VALUES.
 
          SA1    CL+CPBT     UPDATE CPU BASE TIME(S)
          IX6    X1+X2
          SA3    A1+B1
          SA1    CL+CMST+A0  UPDATE MONITOR MODE BASE TIME
          IX7    X3+X2
          SA6    A3-B1
          IX6    X1+X2
          SA6    A1
          SA1    /CME/RTCA   UPDATE *RTC* PARAMETERS IN *CME* BLOCK
          SA7    A3
          IX6    X1+X2
          SA3    A1+B1
          IX7    X3+X2
          SA6    A1
          SA7    A3
          SA1    RTCL        GET MTR-UPDATED *RTCL* IMAGE
          BX6    X1
          SA6    A7+B1
          EQ     /MONITOR/PPRX  EXIT - *OR* PREVIOUSLY CLEARED
 
          ENDBLK
          BLOCK  PROBE,(DATA GATHERING PROBE.)
          SPACE  4,10
*CALL     COMSPDT
 ACE      SPACE  4,10
**        ACE - SET ALTERNATE CPU EXCHANGE.
*
*         ENTRY  (B3) = EXIT ADDRESS.
*                (X0) = 1 IF BIT TO BE SET.
*                (X0) = 0 IF BIT TO BE CLEARED.
*                (X1) = REQUEST WORD.
*                (A1) = ADDRESS OF REQUEST WORD.
*
*         EXIT   ENTRY CONDITIONS PRESERVED.
*                *TACE* TABLE UPDATED.
*                EXIT TO /MONITOR/SPR.
*
*         USES   A - 3, 6.
*                X - 3, 6.
 
 
 ACE      SA3    PRBP
          PL     X3,ACE1     IF *PROBE* TABLES INTERLOCKED
          SX6    A0
          IX3    X3+X6
          SX6    B1+
          SA3    X3+TACE     INCREMENT COUNTER
          IX6    X3+X6
          SA6    A3
 ACE1     JP     /MONITOR/SPB  EXIT
 CIO      SPACE  4,10
**        CIO - *CIO* REQUESTS.
*
*         ENTRY  SEE */MONITOR/CPR* ENTRY CONDITIONS.
*
*         EXIT   TO */MONITOR/CIO* WITH ENTRY CONDITIONS PRESERVED.
*                APPROPRIATE DATA REGION ITEMS UPDATED.
*
*         USES   A - 2, 4, 6.
*                X - 0, 2, 3, 4, 6.
 
 
 CIO      SA4    PRBP
          PL     X4,/CPUCIO/CPC  IF PROBE TABLE INTERLOCKED
          SX3    X5
          SX1    B4
          SX6    B1
          IX0    X3-X1
          PL     X0,CIO2     IF FET ADDRESS .GE. FL
          SA2    B3          GET RA
          IX2    X3+X2       ABSOLUTE REQUEST ADDRESS
          ERX2   X2
          LX2    -2
          SX0    177B        INDEX MASK FOR *CIO* FUNCTION
          BX2    X0*X2
          BX0    X6*X2
          AX2    1
          ZR     X0,CIO1     IF INCREMENTING UPPER COUNTER
          LX6    30
 CIO1     IX4    X2+X4
          SA2    X4+TCIO     INCREMENT COUNTER
          IX6    X2+X6
          SA6    A2+
 CIO2     MX0    48          RESTORE EXIT CONDITIONS
          SX2    B3
          EQ     /CPUCIO/CPC  PROCESS CIO REQUEST
 IOS      SPACE  4,10
**        IOS - I/O STATISTICS FOR BUFFERED I/O.
*
*         ENTRY  (X0) = 48 BIT MASK.
*                (X2) = 49 BIT MASK.
*                (A5) = PP OUTPUT REGISTER ADDRESS.
*
*         EXIT   TO *BIO20*.
*
*         USES   X - 0, 1, 3, 4, 6.
*                A - 3, 4, 6.
*                B - 3, 4.
 
 
 IOS      SA3    PRBP
          PL     X3,/IHPFMD/BIO20  IF *PROBE* TABLE INTERLOCKED
          SA3    A5          READ PP OUTPUT REGISTER
          BX6    -X2*X3      EXTRACT CBT COUNT
          ZR     X6,/IHPFMD/BIO20  IF NO CBT COUNT
          LX3    -24
          SB3    47
          BX1    -X0*X3      EXTRACT PUT ORDINAL
          PL     X3,/IHPFMD/BIO20  IF NOT CLEARING *PUT* INTERLOCK
          SX4    X6-177B
          NX6    X6,B4       DETERMINE *IOST* INDEX
          SB3    B3-B4
          SB4    59-29
          NG     X4,IOS1     IF CBT COUNT IN RANGE
          SB3    7
 IOS1     TA4    IOSP,BDT    FWA OF *IOST*
          SX0    B1+
          LX1    PUTLS
          IX4    X1+X4       FWA OF *IOST* ENTRY
          SA4    X4+B3       READ *IOST* COUNTER
          LX3    59-11-36
          NG     X3,IOS2     IF WRITE OPERATION
          LX0    30
          SB4    B0
 IOS2     IX6    X4+X0       UPDATE *IOST* TABLE
          LX4    X6,B4
          NG     X4,/IHPFMD/BIO20  IF COUNTER OVERFLOW
          SA6    A4
          EQ     /IHPFMD/BIO20  RETURN
 MNR      SPACE  4,10
**        MNR - PROGRAM MODE MTR FUNCTIONS.
*
*         ENTRY  SEE */PROGRAM/MNR* EXIT CONDITIONS.
*
*         EXIT   TO (B6) WITH ENTRY CONDITIONS PRESERVED.
*                APPROPRIATE DATA REGION ITEMS UPDATED.
*
*         USES   A - 3, 6.
*                X - 3, 4, 6.
 
 
 MNR      SA3    PRBP
          SX4    B1+
          PL     X3,MNR1     IF PROBE TABLE INTERLOCKED
          SX3    X3+TMNR
+         SA3    X3+B4       *** PERFORM IN ONE WORD ***
          IX6    X3+X4       *** PERFORM IN ONE WORD ***
          SA6    A3+         *** PERFORM IN ONE WORD ***
 MNR1     JP     B6          RETURN
 PMN      SPACE  4,10
**        PMN - MTR FUNCTIONS.
*
*         ENTRY  SEE */MONITOR/PMN* EXIT CONDITIONS.
*
*         EXIT   TO (B6) WITH ENTRY CONDITIONS PRESERVED.
*                APPROPRIATE DATA REGION ITEMS UPDATED.
*
*         USES   A - 1, 4, 6.
*                X - 1, 4, 6.
 
 
 PMN      SX6    X0+
          SA4    PRBP
          SX1    A0
          PL     X4,PMN2     IF PROBE TABLE INTERLOCKED
          IX4    X6+X4
          SX6    B1
          ZR     X1,PMN1     IF CPU 0
          LX6    30
 PMN1     SA1    X4+TMTR-1   INCREMENT COUNTER
          IX6    X1+X6
          SA6    A1
 PMN2     TJP    (/TRACE/PMN,TRACE,B6)  EXIT
 PPR      SPACE  4,10
**        PPR - PPU FUNCTION REQUESTS.
*
*         ENTRY  SEE */MONITOR/PPR* EXIT CONDITIONS.
*                (A3) = PROCESSOR CONTROL WORD ADDRESS.
*
*         EXIT   TO (B6) WITH ENTRY CONDITIONS PRESERVED.
*                APPROPRIATE DATA REGION ITEMS UPDATED.
*
*         USES   A - 4, 6.
*                B - 6.
*                X - 0, 4, 6.
 
 
 PPR      SA4    PRBP
          SX0    A0+
          SX6    B1
          ZR     X0,PPR1     IF CPU 0
          LX6    30
 PPR1     PL     X4,PPR2     IF PROBE TABLE INTERLOCKED
          SB6    X4+TPPU-TPPR
          SA4    A3+B6       INCREMENT COUNTER
          SB6    X3          SET PROCESSOR ADDRESS
          IX6    X4+X6
          SA6    A4
 PPR2     TJP    (/TRACE/PPR,TRACE,B6)  EXIT
 PRG      SPACE  4,10
**        PRG - PROGRAM MODE PPU REQUESTS.
*
*         ENTRY  SEE */PROGRAM/PRG* EXIT CONDITIONS.
*
*         EXIT   TO (B6) WITH ENTRY CONDITIONS PRESERVED.
*                APPROPRIATE DATA REGION ITEMS UPDATED.
*
*         USES   A - 3, 7.
*                X - 3, 6, 7.
 
 
 PRG      BX6    X3          SAVE ENTRY CONDITIONS
          SA3    PRBP
          SX7    B1
          PL     X3,PRG1     IF PROBE TABLE INTERLOCKED
          SX3    X3+TPRG-CPUM
+         SA3    X3+B4       *** PERFORM IN ONE WORD ***
          IX7    X3+X7       *** PERFORM IN ONE WORD ***
          SA7    A3+         *** PERFORM IN ONE WORD ***
 PRG1     BX3    X6          RESTORE EXIT CONDITIONS
          BX7    X7-X7
          TJP    (/TRACE/PPR,TRACE,B6)  EXIT
 SPL      SPACE  4,10
**        SPL - SEARCH PERIPHERAL LIBRARY.
*
*         ENTRY  SEE */MONITOR/SPL* EXIT CONDITIONS.
*
*         EXIT   TO (B6) WITH ENTRY CONDITIONS PRESERVED.
*                APPROPRIATE DATA REGION ITEMS UPDATED.
*
*         USES   A - 2, 7.
*                X - 2, 3, 4, 7.
 
 
 SPL      SA2    PRBP
          BX3    X7          SAVE ENTRY CONDITIONS
          SX7    A1
          PL     X2,SPL2     IF PROBE TABLE INTERLOCKED
          R=     A2,PLDP
          AX2    36
          IX7    X7-X2
          SX4    B1
          BX2    X4*X7
          LX7    -1
          ZR     X2,SPL1     IF INCREMENTING UPPER COUNTER
          LX4    30
 SPL1     SA2    PRBP
          SX2    X2+TSPL
          IX2    X7+X2
          SA2    X2          INCREMENT COUNTER
          IX7    X4+X2
          SA7    A2
 SPL2     BX7    X3          RESTORE ENTRY CONDITIONS
          JP     B6          RETURN
 
          ENDBLK
          BLOCK  TRACE,(TRACE/TRAP PACKAGE.)
 SETFLD   SPACE  4,10
**        SETFLD - SET UP FIELD VALIDATION REGISTERS.
*
*         ENTRY  (A1) = TRPA.
*                (X1) = (TRPA).
*
*         EXIT   (X1) POSITIONED TO TRAP-ON-ANY-NON-ZERO-VALUE FLAG.
*                (X2) = VALUE TO CHECK AGAINST, AFTER APPLYING MASK.
*                (X3) = WORD ADDRESS.
*                (X6) = POSITIONED MASK.
*                (B5) = LOW BIT OF FIELD.
*
*         USES   X - 1, 2, 3, 6.
*                A - 2.
*                B - 4, 5.
 
 
 SETFLD   MACRO
          LIST   M
          SX3    X1          GET WORD ADDRESS
          LX1    59-41       FLAG TO TRAP ON ANY NONZERO VALUE
          SA2    A1+B1       LOW BIT, MASK LENGTH
          SB5    X2          LOW BIT
          AX2    24
          SB4    X2          GET MASK LENGTH - 1
          MX6    1           CREATE MASK
          AX6    B4
          SB4    B4+B1       POSITION MASK
          LX6    B4
          SA2    A2+B1       GET VALUE
          BX2    X6*X2       APPLY MASK TO VALUE
          LIST   *
          ENDM
 MTRP     SPACE  4,10
**        *DSDI* POINTER WORDS.
*
*         THESE WORDS ARE USED BY *DSDI* DIRECTIVE *TBDUMP* TO LOCATE
*         THE TRACE BUFFERS AND ASSOCIATED INFORMATION IN THE TRACE
*         BLOCK.  IF THE ORDER OR CONTENT OF THESE WORDS IS CHANGED,
*         *DSDI* MUST BE EXAMINED FOR POSSIBLE CHANGES AS WELL.
 
 
 MTRP     VFD    24/0,18/PMNC+PMNCL,18/PMNC   *MTR* TRACE BUFFER
          VFD    42/0,18/PMNA                 *MTR* FUNCTION LIST
          VFD    24/0,18/PMND,18/PMNE         ABS/CPA ADDRESS LISTS
          VFD    24/0,18/PPRC+PPRCL,18/PPRC   *PPU* TRACE BUFFER
          VFD    42/0,18/PPRA                 *PPU FUNCTION LIST
 TRACE    SPACE  4
*CALL     COMSDSL
 TRP      SPACE  4,10
**        TRP - TRAP ON ERROR CONDITION.
*
*         ENTRY  CALLED AT *MTRX*.
*
*         EXIT   TO */MONITOR/MTRX*+1.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 3, 4, 5, 6, 7.
 
 
 TRP      SA1    SSTL
          TB3    MCT
          TB5    SC
          LX1    59-13
          SX0    B5+B5       2 * SYSTEM CP
          NG     X1,/MONITOR/MTRX+1  IF SYSTEM DEBUG MODE DISABLED
          SA2    TRPA
 
*         VALIDATE CM ALLOCATION.
 
          LX2    59-44
          SX7    B7          SAVE (B7)
          PL     X2,TRP7     IF MCT VALIDATION NOT SELECTED
          SA1    SMRL
          NZ     X1,TRP7     IF MEMORY MANAGEMENT OPERATION OCCURRING
          TB6    -200B,PCPA
          SA7    TRPB
          SB7    B0+
 TRP1     TB4    -2,NMCT
          SX1    B1+B1       INITIAL MCT OFFSET (START AT CP 1)
          SX2    B0          INITIAL PREVIOUS INDEX
 TRP2     MX5    12
          SB4    B4-B1
          ZR     B4,TRP5     IF END OF MCT
          SA3    B3+X1       MCT ENTRY
          BX4    X5*X3       BACKWARD LINK
          AX4    48-1
          BX4    X4-X2
          NZ     X4,TRP52    IF BACKWARD LINK INCORRECT
          LX5    -12
          BX2    X1          NEW PREVIOUS INDEX
          BX1    X5*X3       FORWARD LINK
          AX1    36-1
          MX7    -24
          BX5    -X7*X3      HOLE(N-1)
          BX3    X2
          LX7    12
          LX3    7-1
          IX6    X2-X0
          NG     X6,TRP3     IF CP
          LX6    7-1
          SX3    B6+X6
 TRP3     SA4    X3+STSW
          SX3    X3+FLSW
          LX4    59-53
          SA3    X3+B7       CURRENT *FLSW*/*ECSW*
          NG     X4,TRP53    IF ACTIVITY UNDERFLOW
          BX4    X1
          LX4    7-1
          IX6    X1-X0
          NG     X6,TRP4     IF CP
          LX6    7-1
          SX4    B6+X6
 TRP4     SX4    X4+FLSW
          SA4    X4+B7       NEXT *FLSW*/*ECSW*
          BX6    -X7*X4      RA(N) SHIFTED LEFT 12
          BX7    -X7*X3      RA(N-1) SHIFTED LEFT 12
          IX6    X6-X7       RA(N) - RA(N-1) SHIFTED LEFT 12
          NG     X6,TRP51    IF RA-S OUT OF ORDER
          LX6    -12
          IX6    X6-X5       RA(N) - RA(N-1) - HOLE(N-1)
          MX5    12
          BX7    X5*X4       NFL(N)
          LX7    -48
          IX6    X6-X7       RA(N) - RA(N-1) - HOLE(N-1) - NFL(N)
          MX5    -12
          BX7    -X5*X3      FL(N-1)
          IX6    X6-X7       SUBTOTAL - FL(N-1)
          ZR     X6,TRP2     IF ALL IS WELL
          EQ     TRP55       HANG DUE TO MISPOSITIONED HOLE
 
 TRP5     TB4    1,MCT
          EQ     B3,B4,TRP6  IF EM ALREADY VALIDATED
          SA1    ECRL
          SB3    B4+
          SB7    ECSW-FLSW
          NZ     X1,TRP1     IF EM PRESENT
 TRP6     SA1    TRPB        RESTORE (B7)
          SB7    X1+
 
*         VERIFY EJT/PCPA INTEGRITY.
 
 TRP7     SA1    TRPA
          TB3    1,EJTM      MAXIMUM EJT ORDINAL
          LX1    59-42
          PL     X1,TRP11    IF NOT SELECTED
          MX6    -5
          TX7    SC          SYSTEM CONTROL POINT NUMBER
          MX4    -12
 TRP8     SB3    B3-B1       DECREMENT EJT INDEX
          ZR     B3,TRP9     IF END OF SCAN
          SX1    B3
          CX2    X1,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA2    X2+JSNE,EJT
          BX5    X4*X2
          ZR     X5,TRP8     IF VACANT ENTRY
          LX2    -1
          BX0    -X6*X2      JOB STATUS
          SX5    X0-EXJS
          NG     X2,TRP8     IF JOB INTERLOCK SET
          SA3    A2+SCHE-JSNE
          LX3    -12
          BX3    -X4*X3
          NZ     X5,TRP8     IF NOT EXECUTING JOB
          IX3    X3-X7
          PL     X3,TRP56    IF INVALID CONTROL POINT NUMBER
          EQ     TRP8        CONTINUE
 
*         VALIDATE PCPA-S.
 
 TRP9     TB3    SC
          MX4    -5
          TB4    -1,NMCT
          TB6    -200B,PCPA
          SB5    B4-B3       NUMBER OF PCP-S
          MX7    12
 TRP10    ZR     B5,TRP11    IF ALL PCP-S CHECKED
          SX6    B5
          SB5    B5-B1       DECREMENT PCP ORDINAL
          LX6    7
          SX6    B6+X6       PCPA ADDRESS
          SA1    X6+TFSW
          BX1    X7*X1       EJT ORDINAL
          ZR     X1,TRP10    IF VACANT PCP
          LX1    -48
          CX2    X1,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA1    X2+JSNE,EJT
          LX1    59-0
          BX2    -X4*X1      JOB STATUS
          NG     X1,TRP10    IF JOB INTERLOCKED
          SX2    X2-PCJS
          NZ     X2,TRP57    IF INCORRECT JOB STATUS
          SA2    A1+B1
          ERRNZ  SCHE-JSNE-1 CODE DEPENDS ON VALUE
          LX2    12
          BX2    X7*X2
          LX2    -48
          SX3    B3
          IX2    X3-X2
          PL     X2,TRP57    IF INCORRECT PCP NUMBER
          EQ     TRP10       CONTINUE
 
*         CHECK FOR DEAD JOBS.
 
 TRP11    SA2    TRPA
          SA1    DSSL
          LX2    59-43
          PL     X2,TRP14    IF DEAD JOB CHECK NOT SELECTED
          LX1    59-2
          NG     X1,TRP14    IF DEADSTART IN PROGRESS
          SA1    /MONITOR/JAVA
          SX6    B7
          SA6    TRPB        SAVE (B7)
          BX6    X1
          SA6    TRPC        SAVE *JAVA* INSTRUCTION WORD
          SA2    TRPD
          SB3    TRP12       SET *JAV* NON-FAILURE EXIT ADDRESS
          BX6    X2
          SA6    A1          SET *JAV* FAILURE EXIT
 TRP12    SB5    B5-B1
          ZR     B5,TRP13    IF END OF SCAN
          SX1    B5
          LX1    7
          SB7    X1
          EQ     /MONITOR/JAV  CHECK FOR DEAD JOB
 
 TRP13    SA1    TRPB        RESTORE (B7)
          SA2    TRPC        RESTORE *JAVA* INSTRUCTION WORD
          SB7    X1
          BX6    X2
          SA6    /MONITOR/JAVA
 
*         VALIDATE NFL.
 
 TRP14    SA1    TRPA
          TB3    SC
          LX1    59-45
          PL     X1,TRP19    IF NFL VALIDATION NOT SELECTED
          SB4    B0
          SX7    QFBN
          SB6    B0+
 TRP15    SB3    B3-B1
          ZR     B3,TRP18    IF THROUGH WITH CP-S OR PCP-S
          MX0    12
          SX6    B3+B6
          SA1    CMCL
          BX1    X0*X1
          LX1    12
          BX3    X1-X6
          ZR     X3,TRP15    IF STORAGE MOVE IN PROGRESS
          LX6    7
          SX6    X6+B4       ADD BIAS FOR PCPA
          SA1    X6+TFSW
          SA2    X6+FLSW
          BX1    X0*X1
          BX4    X0*X2
          ZR     X1,TRP15    IF CP/PCP NOT ACTIVE
          ZR     X4,TRP15    IF NO NFL ASSIGNED
          LX1    12
          CX6    X1,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA1    X6+JSNE,EJT
          LX1    59-6
          NG     X1,TRP15    IF JOB ADVANCE SET
          AX2    12          COMPUTE RA
          SX2    X2
          LX2    6           RA
          IX2    X2-X7       FWA OF QUEUED FUNCTION BUFFER
          SX6    -QFBL
 TRP16    SX6    X6+B1       READ NEXT ENTRY
          IX4    X2-X6
          ERX4   X4
          ZR     X4,TRP17    IF ZERO ENTRY
          AX4    48          CHECK ENTRY
          SX4    X4-DTKM
          NZ     X4,TRP58    IF NOT *DTKM*
 TRP17    NG     X6,TRP16    IF NOT END OF BUFFER
          EQ     TRP15       CHECK NEXT CP/PCP
 
 TRP18    NZ     B4,TRP19    IF THROUGH CHECKING PCP-S
          TB4    NMCT
          TB6    SC
          SB3    B4-B6       NUMBER OF PCPS+1
          TB4    -CPAS,PCPA  PCPA BIAS
          EQ     TRP15       CHECK PCP-S
 
*         VALIDATE CM FIELD.
 
 TRP19    SA1    TRPA
          BX2    X1
          LX2    59-47
          PL     X2,TRP20    IF CM VALIDATION NOT SELECTED
          SETFLD
          RJ     CFD         CHECK FIELD
          NZ     X3,TRP50    IF ERROR
 
*         VALIDATE CPA FIELD.
 
 TRP20    SA1    TRPA
          BX2    X1
          LX2    59-46
          PL     X2,/MONITOR/MTRX+1  IF CPA VALIDATION NOT SELECTED
          SETFLD
          TX5    SC          SET OFFSET
          SB3    X3
          SB4    B3
          SB6    7
 TRP21    SX5    X5-1
          ZR     X5,TRP22    IF THROUGH CHECKING CP-S OR PCP-S
          LX3    X5,B6
          SX3    X3+B4       ADD WORD ADDRESS AND PCPA BIAS
          RJ     CFD         CHECK FIELD
          NZ     X3,TRP50    IF ERROR
          EQ     TRP21       CHECK NEXT CP/PCP
 
 TRP22    NE     B3,B4,/MONITOR/MTRX+1  IF THROUGH CHECKING PCP-S
          TB4    -CPAS,PCPA  SET PCPA BIAS
          TX3    NMCT
          TX5    SC
          SB4    B4+B3       ADD WORD ADDRESS TO BIAS
          IX5    X3-X5       NUMBER OF PCPS+1
          EQ     TRP21       CHECK PCPA-S
 
 
*         TRAP CONTROL WORDS.
 
 TRPA     VFD    12/TRCM     DSD OUTPUT REGISTER FROM *TRCM*
          VFD    1/0         CM FIELD VALIDATION
          VFD    1/0         CPA FIELD VALIDATION
          VFD    1/0         NFL VALIDATION
          VFD    1/0         MCT VALIDATION
          VFD    1/0         DEAD JOB CHECK
          VFD    1/0         EJT/PCPA VALIDATION
          VFD    1/0         TRAP ON NONZERO VALUE FLAG (FIELD VAL.)
          VFD    17/0        UNUSED
          VFD    24/0        ADDRESS OF WORD TO TRAP/TRACE
          VFD    30/0        UNUSED
          VFD    6/0         LENGTH OF FIELD             (FIELD VAL.)
          VFD    18/0        UNUSED
          VFD    6/0         LOW BIT OF FIELD TO CHECK   (FIELD VAL.)
          CON    0           VALUE TO CHECK              (FIELD VAL.)
 
*         MISCELLANEOUS CELLS.
 
 TRPB     CON    0           (B7) SAVE AREA
 TRPC     CON    0           *JAV* INSTRUCTION WORD SAVE AREA
 TRPD     EQ     TRP54       *JAV* FAILURE INSTRUCTION
 
 
*         DISPLAY MESSAGE AND HANG SYSTEM.
 
 TRP50    SB4    MSGB        FIELD ERROR
          EQ     TRP59       DISPLAY MESSAGE AND HANG
 
 TRP51    SB4    MSGC        RA-S MISORDERED
          EQ     TRP59       DISPLAY MESSAGE AND HANG
 
 TRP52    SB4    MSGD        MCT LINKAGE ERROR
          EQ     TRP59       DISPLAY MESSAGE AND HANG
 
 TRP53    SB4    MSGE        ACTIVITY UNDERFLOW
          EQ     TRP59       DISPLAY MESSAGE AND HANG
 
 TRP54    SB4    MSGF        DEAD JOB FOUND
          EQ     TRP59       DISPLAY MESSAGE AND HANG
 
 TRP55    SB4    MSGG        MISPOSITIONED HOLE
          EQ     TRP59       DISPLAY MESSAGE AND HANG
 
 TRP56    SB4    MSGH        EJT ERROR
          EQ     TRP59       DISPLAY MESSAGE AND HANG
 
 TRP57    SB4    MSGI        PCPA ERROR
          EQ     TRP59       DISPLAY MESSAGE AND HANG
 
 TRP58    SB4    MSGJ        NFL ERROR
          EQ     TRP59       DISPLAY MESSAGE AND HANG
 
 TRP59    RJ     /MONITOR/SVR  SAVE ALL REGISTERS
          RJ     /CPB/RAR    RESTORE ALL REGISTERS
          SA1    B4
          SA2    MSGA
          BX6    X2
          TB5    MS2W,SCA
          SA6    B5
          BX7    X1
          SA7    B5+B1
          SA1    B4+B1
          BX6    X1
          SA6    A7+B1
+         EQ     *           HANG
 
 
 MSGA     DATA   10LTRAP HIT -
 MSGB     DATA   C*FIELD ERROR*
 MSGC     DATA   C*RA-S MISORDERED*
 MSGD     DATA   C*MCT LINKAGE ERROR*
 MSGE     DATA   C*ACTIVITY UNDERFLOW*
 MSGF     DATA   C*DEAD JOB*
 MSGG     DATA   C*MISPOSITIONED HOLE*
 MSGH     DATA   C*EJT ERROR*
 MSGI     DATA   C*PCPA ERROR*
 MSGJ     DATA   C*NFL QFBN ERROR*
 CFD      SPACE  4,10
**        CFD - CHECK FIELD.
*
*         ENTRY  (X1) .LT. 0 IF TRAPPING ON ANY NONZERO VALUE.
*                (X2) = VALUE TO CHECK AGAINST.
*                     = 0 IF TRAPPING ON ANY NONZERO VALUE.
*                (X3) = WORD ADDRESS.
*                (X6) = MASK.
*                (B5) = LOW BIT POSITION OF FIELD.
*
*         EXIT   (X3) = NON-ZERO IF FIELD ERROR.
*
*         USES   X - 3.
*                A - 3.
 
 
 CFD      SUBR               ENTRY/EXIT
          ERX3   X3          GET WORD
          AX3    B5
          BX3    X6*X3       ISOLATE FIELD CONTENTS
          BX3    X2-X3       COMPARE
          NG     X1,CFDX     IF TRAPPING ON ANY NONZERO VALUE
          ZR     X3,CFD1     IF ERROR IN FIELD
          SX3    -1
 CFD1     SX3    X3+1
          EQ     CFDX        RETURN
 PMN      SPACE  4,10
**        PMN - MTR FUNCTIONS.
*
*         ENTRY  SEE */MONITOR/PMN* EXIT CONDITIONS.
*
*         EXIT   TO (B6) WITH ENTRY CONDITIONS PRESERVED.
*
*         USES   X - 1, 3, 4, 6, 7.
*                A - 1, 3, 4, 6, 7.
 
 
 PMN      SA1    SSTL
          SX6    X0
          LX1    59-13
          NG     X1,/MONITOR/RB6  IF SYSTEM DEBUG MODE DISABLED
          SA4    PMNA        CHECK IF THIS FUNCTION TO BE TRACED
          NG     X4,PMN2     IF ALL FUNCTIONS TO BE TRACED
 PMN1     ZR     X4,/MONITOR/RB6  IF TRACE NOT SELECTED FOR THIS ONE
          MX1    -12
          BX1    -X1*X4
          BX1    X1-X6
          AX4    12
          NZ     X1,PMN1     IF NOT A MATCH
 
*         CREATE TRACE BUFFER ENTRY.
 
 PMN2     SX1    X6-ARTF
          ZR     X1,/MONITOR/RB6  IF *ARTF* FUNCTION
          SA1    PMNB        GET *IN* POINTER
          SA4    PDTL        SAVE TIME STAMP ENTRY
          MX3    -24
          BX3    -X3*X4
          SA4    =3L***
          LX3    18
          BX6    X4+X3
          SA4    RTCL
          MX3    -18
          BX3    -X3*X4
          BX6    X6+X3
          SA6    X1
          BX7    X0          SAVE REQUEST
          SA4    PMND        GET LIST OF ABSOLUTE ADDRESSES TO SAVE
          SA7    A6+B1
          SX3    X4
          ERX3   X3
          BX6    X3
          SA6    A7+B1       SAVE FIRST WORD
          AX4    24
          ERX4   X4
          BX7    X4
          SA7    A6+B1       SAVE SECOND WORD
          TA3    -1,MCT
          SX1    B0+
 PMN3     SA3    A3+B1       GET NEXT MCT ENTRY
          BX6    X3
          SA6    A7+1
          SA3    A3+1
          BX7    X3
          SA7    A6+B1
          SX7    X1+
          TX4    1,SC
          IX6    X1-X4
          LX7    7
          NG     X6,PMN4     IF NOT A PCP
          LX6    7
          TX7    X6,PCPA
 PMN4     SA4    PMNE        GET ADDRESSES OF CPA WORDS TO STORE
          LX4    -24
          SX3    X4          GET SECOND ADDRESS
          AX4    36          GET FIRST ADDRESS
          IX4    X4+X7
          SA4    X4
          BX6    X4
          SA6    A7+B1       SAVE FIRST CPA WORD
          IX4    X3+X7
          SA4    X4
          BX6    X4
          SA6    A6+B1       SAVE SECOND CPA WORD
          SA4    X7+TFSW
          BX6    X4
          AX4    48
          SA6    A6+B1       STORE *TFSW* IN TRACE BUFFER ENTRY
          CX7    X4,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA4    X7+JSNE,EJT
          BX7    X4
          SA7    A6+B1       STORE *JSNE* IN TRACE BUFFER ENTRY
          SX1    X1+B1
          TX4    NMCT
          IX4    X1-X4
          NG     X4,PMN3     IF NOT END OF MCT
          SX1    PMNC+PMNCL
          SX6    A7+B1
          TX4    NMCT
          LX7    X4,B1       *NMCT* * 2
          LX4    2           *NMCT* * 4
          IX4    X4+X7       *NMCT* * 6
          SX7    B0+
          IX4    X6+X4
          SX4    X4+TBUFE
          IX4    X4-X1
          NG     X4,PMN5     IF NOT AT TRACE BUFFER LIMIT
          SX6    PMNC
 PMN5     SA6    A1          UPDATE *IN* POINTER
          BX7    X7-X7       RESTORE (X7)
          JP     B6          EXIT TO FUNCTION PROCESSOR
 
 
 PMNA     CON    0           MTR FUNCTION TRACE LIST
 
 PMNB     CON    PMNC        TRACE BUFFER *IN* POINTER
 
 PMNC     BSS    0           TRACE BUFFER
 
 TBUF     DUP    10
 
          LOC    0
 
          CON    0           TIME STAMP
          CON    0           (X0)
          CON    0           VARIABLE - SEE *PMND*
          CON    0           VARIABLE - SEE *PMND*
 
 TBUFE    BSS    0
          LOC    *O
 
 MCT      DUP    NCPS+2+20B  ALLOW MAXIMUM CP-S AND 20B PCP-S
 
          CON    0,0         MCT
          CON    0           VARIABLE - SEE *PMNE*
          CON    0           VARIABLE - SEE *PMNE*
          CON    0           *TFSW*
          CON    0           *JSNE*
 
 MCT      ENDD
          SPACE  4
          ERRNG  PMNCL-6*NCPS-6*NPPS-4-TBUFE  BUFFER TOO SMALL
 
 TBUF     ENDD
 
 PMNCL    EQU    *-PMNC      TRACE BUFFER TABLE LENGTH
 
 PMND     VFD    12/0,24/SMRL,24/CMCL  ADDRESSES OF ABS WORDS TO SAVE
 PMNE     VFD    12/0,24/STSW,24/FLSW  ADDRESSES OF CPA WORDS TO SAVE
 PPR      SPACE  4,10
**        PPR - PP FUNCTION REQUESTS.
*
*         ENTRY  SEE */MONITOR/PPR* EXIT CONDITIONS.
*
*         EXIT   TO (B6) WITH ENTRY CONDITIONS PRESERVED.
*
*         USES   X - 0, 2, 4, 6, 7.
*                A - 2, 4, 6, 7.
 
 
 PPR      SA4    SSTL
          BX0    X5
          LX4    59-13
          NG     X4,PPR4     IF SYSTEM DEBUG MODE DISABLED
          SA4    PPRA        CHECK IF THIS FUNCTION TO BE TRACED
          NG     X4,PPR2     IF ALL FUNCTIONS TO BE TRACED
          AX0    48
 PPR1     ZR     X4,PPR4     IF THIS FUNCTION NOT TO BE TRACED
          MX6    -12
          BX6    -X6*X4
          BX6    X6-X0
          AX4    12
          NZ     X6,PPR1     IF NOT A MATCH
 PPR2     SA2    PPRB        GET *IN* POINTER
          SA4    PDTL        GET TIME STAMP
          MX7    -24
          BX7    -X7*X4
          SA4    =3L***
          LX7    18
          BX6    X4+X7
          SA4    RTCL
          MX7    -18
          BX7    -X7*X4
          BX6    X6+X7
          SA6    X2
          SA2    A5-B1       PP INPUT REGISTER
          BX7    X2
          SA7    A6+B1
          BX6    X5          PP OUTPUT REGISTER
          SA2    A5+B1       MB + 0
          BX7    X2
          SA6    A7+B1
          SA4    A2+B1       MB + 1
          SA7    A6+B1
          BX6    X4
          SA2    A4+B1       MB + 2
          SA6    A7+B1
          BX7    X2
          SA4    A2+B1       MB + 3
          SA7    A6+B1
          BX6    X4
          SA2    A4+B1       MB + 4
          SA6    A7+B1
          BX7    X2
          SA4    A2+B1       MB + 5
          SA7    A6+B1
          BX6    X4
          SA6    A7+B1
          SA2    PMND        GET LIST OF ABSOLUTE ADDRESSES TO SAVE
          SX4    X2          GET FIRST ADDRESS
          AX2    24          GET SECOND ADDRESS
          ERX4   X4
          ERX2   X2
          BX7    X4
          BX6    X2
          SA7    A6+B1
          SA6    A7+B1
          SX4    PPRC+PPRCL
          SX6    A6+B1
          IX4    X6-X4
          SA2    A5-1
          NG     X4,PPR3     IF NOT AT TRACE BUFFER LIMIT
          SX6    PPRC
 PPR3     SA6    PPRB        UPDATE *IN* POINTER
          BX7    X7-X7       RESET (X7)
          LX2    -36+7       RESET (X2)
 PPR4     SX4    7600B       RESTORE (X4)
          JP     B6          EXIT TO FUNCTION PROCESSOR
 
 
 PPRA     CON    0           PPU FUNCTION TRACE LIST
 
 PPRB     CON    PPRC        TRACE BUFFER *IN* POINTER
 
 PPRC     BSS    0           TRACE BUFFER
 
 TBUF     DUP    20D
 
          CON    0           TIME STAMP
          CON    0           PP INPUT REGISTER
          CON    0           PP OUTPUT REGISTER
          CON    0,0,0,0,0,0  PP MESSAGE BUFFER
          CON    0           VARIABLE - SEE *PMND*
          CON    0           VARIABLE - SEE *PMND*
 
 TBUF     ENDD
 
 PPRCL    EQU    *-PPRC      TRACE BUFFER LENGTH
 TRC      SPACE  4,10
**        TRC - PROCESS TRAP/TRACE REQUEST.
*
*         ENTRY  SEE */PPR/TRCM*.
*
*         EXIT   TPRA/PPRA/PMNA/PMND/PMNE SET UP.
*
*         USES   X - 2, 3, 5, 6.
*                A - 3, 6.
 
 TRC      BSS    0           ENTRY
          LX5    0-37
          SA3    A5+B1       GET MB+0
          MX2    -4
          BX2    -X2*X5
          ZR     X2,TRC1     IF NOT *TRACE,XXX*
          BX6    X3
          AX2    1
          SA3    X2+TRCA     GET LIST POINTER FOR *TRACE* REQUESTS
          SA6    X3+
          EQ     TRC2        RETURN
 
 TRC1     BX6    X1
          SA6    TRPA        SAVE *DSD* OR
          BX6    X3
          SA6    A6+B1       SAVE MB+0
          SA3    A3+B1
          BX6    X3
          SA6    A6+B1       SAVE MB+1
 TRC2     JP     /MONITOR/PPR1  EXIT
 
 
 TRCA     CON    PMNE        *TRACE,SET,CPA* ADDRESS LIST
          CON    PMND        *TRACE,SET,ABS* ADDRESS LIST
          CON    PPRA        *TRACE,PPU* FUNCTION LIST
          CON    0           (UNUSED)
          CON    PMNA        *TRACE,MTR* FUNCTION LIST
 
          ENDBLK
          BLOCK  CPB,(CPUMTR BREAKPOINT PACKAGE)
 BKP      SPACE  4,10
**        BKP - *CPUMTR* BREAKPOINT.
*
*         THE DSD COMMAND *CPB,BKP,/B/N* IS USED TO SET A BREAKPOINT.
*         *DSD* SAVES THE WORD AT THE INDICATED ADDRESS IN THE BREAK-
*         POINT TABLE AND REPLACES IT WITH A *RJ  BKP*.  WHEN THE
*         SPECIFIED LOCATION IS HIT, THE *RJ* TAKES THE CPU TO THIS
*         ROUTINE, WHERE ALL REGISTERS ARE STORED IN THE EXCHANGE
*         PACKAGE DISPLAY AREA.  *CPUMTR* THEN LOOPS, WAITING FOR
*         /CPB/CPFG TO BECOME ZERO.  THE *DSD* COMMAND *CPB,GO.*
*         ZEROES THIS WORD, ALLOWING *CPUMTR* TO RESTORE ALL
*         REGISTERS AND CONTINUE EXECUTION.
*
*         THIS ROUTINE IS VALID IN PROGRAM AND MONITOR MODE.
*
*         ENTRY  (CALLED ON *CPUMTR* BREAKPOINT).
*
*         EXIT   (ALL REGISTERS RESTORED).
 
 
 BKP1     SA1    /MONITOR/BXP
          SA2    CHTP        CHECK *DSD* ACTIVE
          LX6    18+18
          BX7    X6+X1       INSERT *P* INTO EXCHANGE PACKAGE
          SX6    B1
          SA7    A1
          AX2    12
          SA3    X2+B1       FETCH DISPLAY CHANNEL STATUS
          MX2    -6
          AX3    12
          BX3    -X2*X3
          IX3    X3-X6
          NZ     X3,BKP3     IF CHANNEL NOT RESERVED TO *DSD*
          SA6    /MONITOR/BXP+CPFG
 BKP2     SA3    A3          CHECK *DSD* ACTIVE
          AX3    12
          SA1    /MONITOR/BXP+CPFG   CHECK BREAKPOINT FLAG
          BX3    -X2*X3
          BX1    X3-X1
          ZR     X1,BKP2     IF FLAG NOT CLEARED AND *DSD* HAS CHANNEL
          SA2    /MONITOR/BXP
          SA3    BKPB        (NO /  NO /  EQ  ** )
          SX6    0
          TA6    MS2W,SCA    CLEAR MESSAGE
          AX2    36
          BX6    X2+X3       CONSTRUCT RETURN ADDRESS
          SA6    BKP
 BKP3     RJ     RAR         RELOAD ALL REGISTERS
 
 BKP      PS                 ENTRY/EXIT
          RJ     /MONITOR/SVR  SAVE ALL REGISTERS
          SA1    =C$CPUMTR BREAKPOINT HIT$
          SA2    A1+B1
          SA3    A2+B1
          BX6    X1
          BX7    X2
          SA2    BKP         GET RETURN ADDRESS
          SA1    /MONITOR/BXP+CPBA   BREAKPOINT ADDRESS
          TA6    MS2W,SCA
          BX6    X3
          SA7    A6+B1
          SA6    A7+B1
          AX2    30
          SX6    X2-1        RETURN ADDRESS - 1
          BX7    X6-X1       CHECK FOR SAME ADDRESS
          SX6    X6+B1
          NZ     X7,BKP1     IF NOT AT BREAKPOINT ADDRESS
          SA2    /MONITOR/BXP+CPBW
          SA7    A2          CLEAR BREAKPOINT WORD
          SA7    A1          ZERO BREAKPOINT ADDRESS
          SX6    X6-1
          BX7    X2          RESET BREAKPOINT WORD
          SA7    X6
          EQ     BKP1        CHECK *DSD* ACTIVE
 
 
 BKPB     NO                 PROTOTYPE RETURN INSTRUCTION
          NO
          EQ     **          (RETURN ADDRESS INSERTED HERE)
 RAR      SPACE  4,10
**        RAR - RELOAD ALL REGISTERS.
*
*         ENTRY  REGISTER DATA AT */MONITOR/BXP*.
*
*         EXIT   ALL REGISTERS RELOADED.
 
 
 RAR      PS                 ENTRY/EXIT
          SB7    /MONITOR/BXP
          SB1    1           SET REGISTER ARRAY FOR *B0* - *B7*, *A0*
          SB4    3
          MX0    42
          SA3    B7          FETCH *A0*
          AX3    18
          SA2    B7+7
 RAR1     SA1    B4+RARB     GET RESET INSTRUCTION
          BX2    -X0*X2
          BX3    -X0*X3
          IX6    X2+X1       *B7*/*B5*/*B3*/*B1* TO RESET INSTRUCTION
          SB2    B2-2
          LX6    30
          IX6    X6+X3       *AO*/*B6*/*B4*/*B2* TO RESET INSTRUCTION
          SA6    B4+RARA     STORE RESET INSTRUCTION
          SB4    B4-B1
          SA3    A2-B1       FETCH *B6*/*B4*/*B2*
          SA2    A3-B1       FETCH *B5*/*B3*/*B1*
          PL     B4,RAR1     IF MORE TO GO
          SA1    B7+7        *A7*
          AX1    18
          SA2    X1          OLD VALUE AT *A7*
          BX7    X2
          SA3    A1-B1       *A6*
          AX3    18
          SA4    X3          OLD VALUE AT *A6*
          LX6    X4
          SA7    X1+777777B  RESTORE *A7*
          SA6    X3+777777B  RESTORE *A6*
          SA1    B7+17B      *X7*
          SA2    A1-B1
          BX7    X1          RESTORE *X7*
          LX6    X2          RESTORE *X6*
          SA3    A3-B1       *A5*
          SA1    A2-B1       *X5*
          AX3    18
          SA5    X3+777777B  RESTORE *A5*
          SA3    A3-B1       *A4*
          SA2    A1-B1       *X4*
          AX3    18
          BX5    X1          RESTORE *X5*
          SA4    X3+777777B  RESTORE *A4*
          SA3    A3-B1       *A3*
          SA1    A2-B1       *X3*
          BX4    X2          RESTORE *X4*
          SA2    A3-B1       *A2*
          AX2    18
          AX3    18
          SA3    X3+777777B  RESTORE *A3*
          SA2    X2+777777B  RESTORE *A2*
          BX3    X1          RESTORE *X3*
          SA1    A1-B1       *X2*
          BX2    X1          RESTORE *X2*
          SA1    A1-B1       *X1*
          UX0    B1,X1       START UNPACKING *X1*
          LX0    11
          UX1    B2,X0       CONTINUE UNPACK
          LX1    11
          UX0    B3,X1
          LX0    11
          UX1    B4,X0
          MX0    60
          SA0    X0+777777B  -0 TO *A0*
          LX1    11
          UX0    B5,X1
          SA1    A1-1        *X0*
          LX0    11
          SB7    X0+777777B  SIGN OF *X1* TO *B7*
          UX0    B6,X0       COMPLETE UNPACK
          BX0    X1          RESTORE *X0*
          NO
          SA1    A1-7        *A1*
          AX1    18
          SA1    X1+777777B  RESTORE *A1*
          SX1    B7-B0       RESTORE SIGN OF *X1*
          PX1    B6,X1       START REPACKING *X1*
          AX1    11
          PX1    B5,X1
          AX1    11
          PX1    B4,X1
          AX1    11
          PX1    B3,X1
          AX1    11
          PX1    B2,X1
          AX1    11
          PX1    B1,X1       COMPLETE RESTORATION OF *X1*
 RARA     DATA   0,0,0,0
          EQ     RAR         RETURN
 
 
 RARB     SB2    A0+0        RESET INSTRUCTIONS
          SB1    A0+0
          SB4    A0+0
          SB3    A0+0
          SB6    A0+0
          SB5    A0+0
          SA0    A0+0
          SB7    A0+0
          SPACE  4,10
          ENDBLK
          BLOCK  SCP,(SYSTEM CONTROL POINT FACILITY.),MONITOR
          TITLE  SCP MAIN ROUTINES.
 SSC      SPACE  4,10
 
***       *SSC*.
*         A SUBSYSTEM CALL FROM A USER CONTROL POINT (UCP) WHICH
*         USES THE SYSTEM CONTROL POINT FACILITY. THIS UCP CALL IS SENT
*         TO THE APPROPIATE SUBSYSTEM DETERMINED BY THE SUBSYSTEM
*         IDENTIFICATION (SID).  THE SUBSYSTEM IS CHECKED TO SEE IF
*         IT HAS ATTAINED *SYSTEM CONTROL POINT* (SCP) STATUS, THAT IS
*         THE SUBSYSTEM IDENTIFICATION WORD (SSIW) IS INITIALIZED. IF
*         NOT THE *SUBSYSTEM NOT PRESENT* STATUS IS RETURNED. ALSO,
*         THE SUBSYSTEM RECEIVING BUFFER (SSCR) IS EXAMINED TO SEE
*         WHETHER OR NOT THE SUBSYSTEM IS READY TO RECEIVE REQUESTS.
*         IF UNABLE TO THE *SUBSYSTEM BUSY* STATUS IS RETURNED.
*
*T        18/  *SSC*,1/,1/R,4/,18/ SID,18/ ADDR
*
*         ADDR = ADDRESS OF A PARAMETER BLOCK.
*         R    = 1 IF AUTO-RECALL SELECTED.
*         SID  = SUBSYSTEM IDENTIFICATION.
*                IF ZERO, SCP IS READY TO ACCEPT REQUESTS
*                FROM UCPS.
*                IF NONZERO, *ADDR* IS THE FIRST WORD OF A BLOCK
*                OF DATA TO BE PROCESSED BY THE SCP.
*
*T ADDR   24/  RSUB,12/  RINS,6/WCNT,4/RCDC,2/RT,11/ ES,1/C
*T ADDR+1 60/ SUBSYSTEM SPECIFIED PARAMETERS
*T ADDR+N 60/ LAST WORD OF PARAMETER BLOCK
*
*         C =    1, WHEN REQUEST HAS BEEN COMPLETED.
*         ES =   ERROR AND STATUS INFORMATION -
*
*                BIT         DESCRIPTION
*
*                1           0 = SUBSYSTEM PRESENT.
*                            1 = SUBSYSTEM NOT RUNNING.
*                2           0 = SUBSYSTEM ACCEPTED REQUEST.
*                            1 = SUBSYSTEM TOO BUSY TO ACCEPT REQUEST.
*                3           0 = SUBSYSTEM IS DEFINED.
*                            1 = SUBSYSTEM IS UNDEFINED.
*                4 - 5       RESERVED FOR CDC.
*                6 - 11      OTHER ERRORS -
*                            00 = NO OTHER ERROR.
*                            01-17 = RESERVED FOR CDC SYSTEM ERRORS.
*                            20-67 = RESERVED FOR CDC SUBSYSTEM ERRORS.
*                            70-77 = RESERVED FOR INSTALLATIONS.
*
*         RT =   STATUS RETURN DIRECTIVE -
*
*                BIT         DESCRIPTION
*
*                12          0 = IF SUBSYSTEM BUSY, HALT PROGRAM UNTIL
*                                REQUEST CAN BE POSTED TO SUBSYSTEM.
*                            1 = IF SUBSYSTEM BUSY, SET BIT 2 IN ES AND
*                                ALLOW PROGRAM TO CONTINUE.
*                13          0 = ABORT PROGRAM ON ALL ERRORS.
*                            1 = ABORT PROGRAM ONLY ON FATAL ERRORS.
*         RCDC = RESERVED FOR CDC.
*         WCNT = WORD COUNT - 1 OF PARAMETER BLOCK.
*         RINS = RESERVED FOR INSTALLATION.
*         RSUB = RESERVED FOR SUBSYSTEM.
 
 
 SSC      SX7    B0+         CLEAR COMMUNICATION BUFFER ADDRESS WORD
          SA7    APQA
          SA7    SSFG        CLEAR *STSW* STATUS
          SA7    SSTA        CLEAR FST ADDRESS FOR *SST* CALLS
          SX6    X4-3RSSF
          SX7    X4-3RSST
          ZR     X6,SSF      IF *SSF*
          SX4    X4-3RSSC
          ZR     X7,SST      IF *SST*
          NZ     X4,APJ      IF NOT *SSC*
 
*         CHECK CALL ARGUMENTS.
 
          SB5    X5          CHECK ADDR WITHIN RANGE
          LX5    -18         EXTRACT SUBSYSTEM ID
          LE     B5,B1,CPE   IF ADDR .LE. 1
          SB4    B4-B5
          SX7    -B4
          LE     B4,B1,CPE   IF ADDR+1 .GE. FL
          SX6    B5          CHECK COMPLETE BIT
          SA3    B3
          IX4    X3+X6
          ERX3   X4
          BX6    X0*X3       CLEAR ERROR STATUS FIELD
          LX3    -1
          NG     X3,CPE      IF COMPLETE BIT ALREADY SET
          EWX6   X4
          SX2    X5          SET SSID
          SA4    B7+SSCW     SUBSYSTEM CONTROL WORD
          ZR     X2,SSC11    IF SPECIAL SUBSYSTEM INITIALIZATION CALL
          SB4    SSC1        RETURN ADDRESS FOR *CSC*
          BX3    X4
          EQ     CSC         CHECK SUBSYSTEM CONNECTION
 
 SSC1     SX1    X5
          PX5    X1,B6       SAVE SHIFT COUNT AND SSID
          SA2    B7+AACW     CHECK VALIDATION OF CP AS UCP
          SX6    EC01        * TOO MANY SCP CONNECTIONS.*
          LX6    6
          SX6    X6+B1       SET COMPLETION BIT
          ZR     B6,SSC3.1   IF REQUEST TO 6TH SUBSYSTEM (*SSCW* FULL)
          LX2    59-11
          MX3    -3
          LX4    B6          POSITION *SSCW*
          BX6    -X3*X4      NUMBER OF REQUESTS
          SX6    X6-MAXR
          SB3    SSC4        RETURN ADDRESS
          ZR     X6,SSC10    IF MAXIMUM NUMBER OF REQUESTS
          NG     X2,RSC      IF VALIDATED
          SA2    B7+SEPW     CHECK FOR *SSJ=* ENTRY POINT
          LX2    59-50
          NG     X2,RSC      IF *SSJ=* ENTRY POINT
 
*         ABORT UNAUTHORIZED UCP WITH NO EXIT OR REPRIEVE PROCESSING.
*         *1MA* CALLED TO ISSUE *ILLEGAL USER ACCESS* ERROR MESSAGE
*         AND SET *SYET* ERROR FLAG.
 
 SSC2     MX0    1           FORCE UCP INTO RECALL
          SA2    RA1         RA+1 ADDRESS
          ERX5   X2
          LX0    40-59
          BX6    X5+X0
          EWX6   X2
          LX0    18-59-40+59 SET *1MA* MESSAGE INDEX
          SX2    B1+B1       SET *1MA* FUNCTION CODE
          SX5    B7          SET UCP CP ADDRESS
          EQ     SSC15       CALL *1MA* TO ISSUE MESSAGE AND SET ERROR
 
*         PROCESS SUBSYSTEM NOT PRESENT.
 
 SSC3     SX6    ES1+1       * SUBSYSTEM NOT PRESENT.*
 SSC3.1   SA1    RA          RA OF USER
          SX3    B5          PARAMETER ADDRESS
          IX3    X3+X1       ABSOLUTE ADDRESS
          ERX1   X3          SET ERROR STATUS AND COMPLETION BIT
          BX6    X6+X1       MERGE ERROR STATUS
          LX1    59-13       CHECK ABORT DESIRED
          BX7    X7-X7
          EWX6   X3
          PL     X1,CPE      IF ABORT
          EQ     MTRP        EXIT TO STORE OUTPUT REGISTER
 
*         RETURN FROM *RSC* WITH -
*
*         (A2) = SUBSYSTEM *STSW* WORD IN CP AREA.
*         (B5) = RELATIVE ADDRESS OF USER PARAMETER AREA.
*         (X0) = -7777B.
*         (X3) = SUBSYSTEM RA.
*         (X5) = SHIFT COUNT AND SUBSYSTEM IDENTIFICATION.
*         (X6) = SUBSYSTEM FL.
*         (X7) = -(NUMBER OF WORDS ALLOWED FOR PARAMETER AREA.)
*
*         *RSC* ERROR EXIT ADDRESSES -
 
+         VFD    12/SSC3-SSC4,18/SSC12,12/SSC10-SSC4,18/SSC10
 
 SSC4     SX4    SSIW        CHECK SUBSYSTEM IDENTIFICATION WORD
          IX4    X4+X3
          ERX4   X4
          BX4    X4-X5
          SX1    X4
          NZ     X1,SSC3     IF SUBSYSTEM NOT INITIALIZED AS SCP
          SA4    A2-STSW+EECW  GET REPRIEVE STATUS
          LX4    59-58
          LX1    X4,B1
          PL     X4,SSC4.1   IF NOT EXTENDED REPRIEVE MODE
          NG     X1,SSC10    IF INTERRUPT HANDLER ACTIVE
 SSC4.1   SA4    A2-STSW+SSOW  GET OUTSTANDING CONNECTION COUNT
          SX1    SSCR
          IX1    X1+X3
          ERX1   X1          READ SUBSYSTEM RECEIVING BUFFER POINTER
          BX2    X0+X4
          SB6    X6          (B6) = SUBSYSTEM FL
          SA4    B7+SEPW     CHECK FOR SSJ= ENTRY POINT
          LX6    X1,B1
          LX4    59-50
          PL     X6,SSC5     IF NO RESTRICTION ON UCP ACCESS
 
*         ALLOW PRIVILEGED PROGRAM UCP ONLY (SSJ= ENTRY POINT OR
*         SUBSYSTEM).
 
          NG     X4,SSC5     IF SSJ= ENTRY POINT
          SA4    B7+JCIW     CHECK FOR SUBSYSTEM
          LX4    36
          BX4    -X0*X4
          ZR     X4,SSC2     IF NOT AUTHORIZED UCP
 SSC5     SB3    X1          RECEIVING BUFFER ADDRESS
          ZR     X2,SSC10    IF MAXIMUM NUMBER OF REQUESTS OUTSTANDING
          AX1    18
          NG     X1,SSC10    IF SUBSYSTEM NOT READY FOR DATA
          BX2    -X0*X1      LENGTH OF PARAMETER AREA (LP)
          ZR     B3,SSC10    IF NO SUBSYSTEM RECEIVING BUFFER POINTER
          LE     B3,B1,SSC13 IF AP OUT OF RANGE
          SB4    X1-HDRL     (B4) = LP - HDRL
          AX1    18          EXTRACT XP
          SA4    RA
          SX6    B5
          IX4    X6+X4
          ERX4   X4          READ VARIABLE LENGTH WORD COUNT
          MX6    -6
          SB3    B3+HDRL     DATA ADDRESS
          PL     B4,SSC6     IF NOT VARIABLE LENGTH WORD COUNT
          LX4    -18
          BX4    -X6*X4      VARIABLE LENGTH OF BUFFER (WC)
          SX6    X4+HDRL
          IX6    X6-X2
          PL     X6,CPE      IF WC .GT. LP
          SB4    X4+B1       (B4) = VARIABLE LENGTH WORD COUNT
 SSC6     SX4    B4-MAXB-1
          SX6    B4+X7
          SX7    B3-B6
          PL     X6,CPE      IF PARAMETER BLOCK BEYOND UCP FL
          SX2    X7+B4
          BX4    X4*X2
          SX1    X1+
          SX2    B5+         FWA OF PARAMETER BLOCK
          PL     X4,SSC13    IF LP .GE. FL(SS) OR LP .GT. MAXIMUM
          ZR     X1,SSC8     IF NO XP TO MOVE
 
*         MOVE EXCHANGE PACKAGE.
 
          PX2    X2,B4       SAVE (B4)
          IX0    X1+X3       ABSOLUTE ADDRESS OF XP MOVE
          SB4    20B         NUMBER OF WORDS TO TRANSFER
          SB5    X1+B4       LWA+1 OF XP MOVE
          SX6    B2          ADDRESS OF EXCHANGE PACKAGE
          GE     B5,B6,SSC13 IF XP MOVE BEYOND FL
          SB6    SSC7        *MSM* *MSR* RETURN ADDRESS
          IX1    X6-X0       COMPUTE INCREMENT
          SX0    B2          FWA TO TRANSFER
          TJP    (/CME/MSR,CME,/MONITOR/MSM,CMUMTR,/MONITOR/MSR)
 
 SSC7     UX2,B4 X2          (B4) = LENGTH OF PARAMETER BLOCK
          SB5    X2+         (B5) = FIRST WORD OF PARAMETER BLOCK
 
*         MOVE PARAMETER BLOCK.
 
 SSC8     SA1    RA          USER RA
          SX6    B5
          IX0    X6+X1       FWA OF TRANSFER
          SX1    B3+
          IX1    X3+X1       FWA OF DATA BUFFER
          IX1    X0-X1
          SB6    SSC9        *MSM* *MSR* RETURN ADDRESS
          TJP    (/CME/MSR,CME,/MONITOR/MSM,CMUMTR,/MONITOR/MSR)
 
*         STORE HEADER INFORMATION.
 
 SSC9     SA1    B7+TFSW     GET EJT ORDINAL
          SA4    B7+SEPW
          MX0    -12
          SX6    10000B
          LX1    12
          LX4    12-52
          BX1    -X0*X1
          BX6    X6*X4
          CX4    X1,EJT      CONVERT EJT ORDINAL TO OFFSET
          BX1    X6+X1       MERGE *DMP=* FLAG AND EJT ORDINAL
          TA4    X4+JSNE,EJT GET JOB SEQUENCE NUMBER
          SX6    4000B
          MX7    24
          BX7    X7*X4
          BX6    X4+X6       SET SCP CONNECTION FLAG
          SA6    A4
          BX7    X7+X1
          SX1    B3-B1
          IX1    X1+X3
          EWX7   X1          STORE SECOND HEADER WORD
          UX2,B3 X5          (B3) = SHIFT COUNT, (X2) = SSID
          SX6    B1
          SA5    RA1
          ERX5   X5          READ (RA+1)
          IX1    X1-X6
          SX6    X5          ADDRESS OF UCP PARAMETER BLOCK
          EWX6   X1          STORE FIRST HEADER WORD
 
*         SET CPU INTERLOCK BIT.
 
          SX1    SSCR
          IX7    X1+X3
          ERX1   X7
          MX0    1
          BX6    X0+X1
          TIC    DCPC        INVALIDATE OTHER CPU CACHE IF PRESENT
          EWX6   X7
 
*         UPDATE CPA-S.
 
          SX3    B1
          SA4    A2-STSW+SSOW INCREMENT NUMBER OF OUTSTANDING REQUESTS
          IX7    X4+X3
          SA1    B7+SSCW
          SA7    A4
          LX1    B3          POSITION WAIT RESPONSE INDICATORS
          SX6    X2-LSSI     ADD SUBSYSTEM INDEX TO *SSCW*
          LX6    6
          BX6    X1+X6
          IX6    X3+X6       INCREMENT WAIT RESPONSE INDICATORS
          SB6    60
          SB3    B6-B3
          LX6    B3
          BX7    X5
          SA6    A1
          MX0    -36
          LX7    59-40       CHECK AUTO RECALL DESIRED
          SA1    RC          BUILD *RCLP* REQUEST
          BX5    -X0*X5
          AX7    59
          BX6    X1+X5
          BX6    X7*X6       CLEAR (RA+1) IF RECALL NOT SELECTED
          SB3    SSC9.1      *RCC* RETURN ADDRESS
          SA1    RA1
          EWX6   X1
          MX1    -3
          SA2    A2+         CHECK CPU STATUS
          LX2    3
          BX2    -X1*X2
          SX2    X2-XCPS
          NZ     X2,SSC9.2   IF NOT *X* STATUS
          SA7    T1          SAVE (X7)
          SB6    A2-STSW     SET EXCHANGE PACKAGE ADDRESS
          EQ     RCC         RECALL SCP
 
 SSC9.1   SA1    T1          RESTORE (X7)
          BX7    X1
 SSC9.2   NG     X7,MTR      IF RECALL DESIRED
          EQ     MTRX        EXIT
 
*         PROCESS SUBSYSTEM BUSY.
 
 SSC10    SA1    RA
          SX2    B5
          IX2    X2+X1       CHECK RECALL DESIRED
          ERX1   X2
          SX4    ES2+1       * SUBSYSTEM BUSY.*
          BX6    X1+X4
          LX1    59-12
          BX7    X7-X7
          PL     X1,SXS      IF RECALL DESIRED
          EWX6   X2
          EQ     MTRP        EXIT
 
*         PROCESS SPECIAL SUBSYSTEM INITIALIZATION CALL.
 
 SSC11    SB6    SSC12       SET RETURN ADDRESS FOR *RSI*
          EQ     RSI         RETURN SUBSYSTEM INFORMATION
 
*         PROCESS ILLEGAL SUBSYSTEM IDENTIFICATION.
 
 SSC12    SX7    ES3+1       *SUBSYSTEM ID ILLEGAL.*
          EQ     SSC12.1     SET ERROR STATUS
 
*         RETURN FROM *RSI* WITH SUBSYSTEM INFORMATION.
 
+         SX7    B1+         SET COMPLETION BIT
          SB6    X3+11       SET SUBSYSTEM ACTIVE FLAG IN *SSCT*
          LX6    X7,B6
          BX6    X2+X6
          SA6    A2+
 SSC12.1  SA1    RA          SET RETURN CODE
          SX2    B5
          IX2    X2+X1
          ERX1   X2
          BX6    X1+X7
          MX7    0
          EWX6   X2
          EQ     MTRP        EXIT
 
*         ABORT SUBSYSTEM FOR ILLEGAL XP, AP, OR LP PARAMETERS.
*
*         (B5) = ADDRESS OF UCP PARAMETER AREA.
*         (X3) = SUBSYSTEM RA.
*         (A2) = *STSW* WORD IN SUBSYSTEM CP AREA.
 
 SSC13    SX6    B5          SAVE UCP PARAMETER ADDRESS
          LX3    30          SAVE SCP RA
          BX6    X3+X6
          SX0    B0          FORCE SCP ABORT
          SA6    T2
          SX5    A2-STSW     SUBSYSTEM CP ADDRESS
          SX2    2           SET *1MA* FUNCTION CODE
 
*         CALL *1MA*.  (ALSO ENTERED HERE FROM *SSF*.)
*
*         (X0) = 36/0, 6/INDX, 18/ADDR
*                INDX = SUBSYSTEM INDEX, OR MESSAGE INDEX IF ADDR = 0.
*                ADDR = RELATIVE ADDRESS OF SUBSYSTEM PARAMETER WORD.
*                     = 0, IF *CPUMTR* REQUESTING ABORT.
*         (X2) = *1MA* FUNCTION CODE.
*         (X5) = CP ADDRESS.
 
 SSC15    SA4    X5+STSW     CHECK ROLLOUT REQUESTED
          SX6    3R1MA       BUILD *1MA* REQUEST
          BX7    X0          SAVE *1MA* PARAMETER
          SA7    T1
          LX6    59-17
          SB3    SSC17       SET RETURN ADDRESS
          LX2    24
          BX6    X6+X0
          LX4    59-24
          BX6    X6+X2
          NG     X4,SSC19    IF ROLLOUT REQUESTED
          SX0    B7          SAVE CONTROL POINT ADDRESS
          SB7    X5
          SB4    -1          PROHIBIT QUEUING
          MX1    1           SET CHECK ACTIVITY FLAG
          BX0    X0+X1
          SB6    SSC16       SET RETURN IF NOT AT ACTIVITY LIMIT
          EQ     CAL         CHECK ACTIVITY LIMIT
 
 SSC16    SX0    X0          CLEAR CHECK ACTIVITY FLAG
          TJP    (/DCP/APQ,DCPC,/MONITOR/APQ)  ASSIGN PP
 
 SSC17    SB5    B7+         SAVE CPA ADDRESS
          SB7    X0          RESTORE (B7)
          BX7    X7-X7
          NG     X0,SSC19    IF TOO MUCH ACTIVITY
          NZ     X1,SSC17.2  IF PP ASSIGNED
          MX7    1           SETUP TO QUEUE THE REQUEST
          SA2    APQA
          SB7    B5          RESTORE CONTROL POINT ADDRESS
          BX7    X7+X2
          SX2    NPQ
          SA7    AQRA
          SB3    SSC17.1
          EQ     AQR         QUEUE AS A NO ROLL REQUEST
 
 SSC17.1  SB7    X0+         RESTORE (B7)
          SX7    B0+
 SSC17.2  SA1    T1          CHECK *1MA* PARAMETER
          NZ     X1,SSC18    IF NOT SCP ABORT
          SA3    T2          GET UCP PARAMETER ADDRESS AND SCP RA
          SA1    RA          GET UCP RA
          SX2    X3
          AX3    30
          IX2    X1+X2
          ERX1   X2          SET ERROR STATUS IN UCP PARAMETER BLOCK
          ERRNZ  ES1-2       CODE DEPENDS ON VALUE OF *ES1*
          MX6    -2
          BX6    -X6+X1
          EWX6   X2
          SX2    SSIW        CLEAR SUBSYSTEM IDENTIFICATION WORD
          IX2    X3+X2
          TIC    DCPC        INVALIDATE CACHE ON OTHER CPU, IF PRESENT
          EWX7   X2
 SSC18    SA2    RA1
          ERX5   X2          GET CALL ADDRESS
          MX6    -36
          BX0    -X6*X5
          LX5    59-40
          SA4    RC          BUILD *RCLP* REQUEST
          SA1    B5+STSW     UPDATE *STSW*
          SA3    SSFG
          BX6    X1+X3
          SA6    A1
          PL     X5,MTRP     IF NOT AUTO RECALL
          BX7    X4+X0       SET *RCLP* REQUEST
          EWX7   X2
          EQ     MTR         ENTER RECALL STATUS
 
 SSC19    SA1    APQA        CLEAR BUFFER INTERLOCK
          SA2    RA1
          ZR     X1,SSC20    IF NO BUFFER
          BX6    X6-X6
          SA6    X1
 SSC20    SA4    SSTA
          ERX1   X2          GET RA+1 REQUEST
          ZR     X4,SXS      IF NO FNT INTERLOCK TO CLEAR
          LX1    17-59       POSITION REQUEST NAME
          SX1    X1-3RSST
          ZR     X1,SST9     IF *SST* REQUEST
          EQ     SXS         SET *X* STATUS
 
*         THE FOLLOWING CHECKS ARE MADE TO INSURE THAT THESE TAGS
*         ARE BENEATH RA+100B OF SUBSYSTEM FL.
 
          ERRNG  77B-SSIW
          ERRNG  77B-SSCR
 SSF      SPACE  4,10
***       *SSF*.
*         PROCESS SUBSYSTEM FUNCTION CALLS.
*
*T        18/  *SSF*,1/ ,1/R,4/ ,18/0,18/  ADDR
*
*T ADDR   6/ RC,12/  FP,18/  UCPA,18/  SCPA,6/ FC
*T ADDR+1 24/ JSEQ,23/0,1/D,12/ JEJT
*T ADDR+2 1/U,1/S,10/ 0,24/ EUCPA,24/ ESCPA
*
*         FC     FUNCTION CODE -
*                02          SEND DAYFILE MESSAGE AND/OR ABORT USER.
*                04          UPDATE USER JOB ACCOUNTING.
*                06          COMPLETE USER REQUEST.
*                10          READ USER JOB MEMORY.
*                12          RETURN USER JOB STATUS.
*                14          WRITE USER JOB MEMORY.
*                16          EXIT FROM SYSTEM CONTROL POINT STATUS.
*                24          ALLOW USER SWAPPING.
*                26          SWAP IN USER JOB.
*                30          SET LONG TERM CONNECTION.
*                32          CLEAR LONG TERM CONNECTION.
*                34          ALLOW MULTIPLE REQUEST CAPABILITY.
*                40          EXTENDED READ USER JOB CM/ECS.
*                42          EXTENDED MULTIPLE REQUEST PROCESSING.
*                44          EXTENDED WRITE USER JOB CM/ECS.
*                46          RETURN USER JOB IDENTIFICATION.
*                50-66       RESERVED FOR CDC.
*                70-76       RESERVED FOR INSTALLATIONS.
*         SCPA   A DATA ADDRESS WITHIN THE SUBSYSTEM MEMORY.
*         UCPA   A DATA ADDRESS WITHIN A USER JOB MEMORY.
*         FP     A PARAMETER MEANINGFUL TO A PARTICULAR FUNCTION.
*         RC     SYSTEM REPLY - (SEE *COMSSCP*)
*                34-37       RESERVED FOR INSTALLATIONS.
*                40          AT LEAST ONE ERROR ENCOUNTERED IN LIST.
*                41          JOB IDENTIFIER IS INVALID.
*                42          SCP CM/ECS ADDRESS OUT OF RANGE.
*                43          UCP CM/ECS ADDRESS OUT OF RANGE.
*                44          USER JOB IS SWAPPED OUT.
*                45          USER JOB IS NOT IN THE SYSTEM.
*                46          SWAP IN REQUEST TEMPORARILY PROHIBITED.
*                47-55       RESERVED FOR CDC.
*                56          ECS ABORT/PARITY ERROR.
*                57          CONNECTION PREVIOUSLY ESTABLISHED.
*                60          CONNECTION REJECTED.
*                61          CONNECTION NOT PREVIOUSLY ESTABLISHED.
*                62          WORD TRANSFER TOO LONG.
*                63          UCP NOT ESTABLISHED WITH SUBSYSTEM.
*                64          SUBSYSTEM IS ESTABLISHED WITH RECEIVER.
*                65          ATTEMPT TO SET ILLEGAL ERROR FLAG.
*                66          ILLEGAL DAYFILE PROCESSING FLAG.
*                67-73       RESERVED FOR CDC.
*                74-77       RESERVED FOR INSTALLATIONS.
*         JEJT   JOB EJT ORDINAL.
*         D      IF SET, UCP MUST BE *DMP=* PROGRAM, OTHERWISE UCP MUST
*                NOT BE *DMP=* PROGRAM.
*         JSEQ   JOB SEQUENCE NUMBER.
*         EUCPA  UCP CM OR ECS ADDRESS, FOR SF.XRED (40) AND
*                SF.XWRT (44) FUNCTIONS ONLY.
*         ESCPA  SCP CM OR ECS ADDRESS, FOR SF.XRED (40) AND
*                SF.XWRT (44) FUNCTIONS ONLY.
*         U      IF SET, EUCPA IS UCP ECS ADDRESS, OTHERWISE EUCPA
*                IS UCP CM ADDRESS.
*         S      IF SET, ESCPA IS SCP ECS ADDRESS, OTHERWISE ESCPA
*                IS SCP CM ADDRESS.
 
 
 SSF      BSS    0           ENTRY
 
*         CHECK CALL ARGUMENTS.
 
          SA2    B7+JCIW     CHECK SUBSYSTEM CALL
          SB6    X5          CHECK ADDR WITHIN RANGE
          LX2    -24
          LE     B6,B1,CPE   IF ADDR .LE. 1
          SA3    B3          RA OF SUBSYSTEM
          SX1    SSIW        SUBSYSTEM IDENTIFICATION WORD
          IX1    X3+X1
          ERX1   X1
          BX7    -X0*X1      SUBSYSTEM IDENTIFICATION FROM RA+SSIW
          GE     B6,B4,CPE   IF ADDR .GE. FL
          BX4    -X0*X2      SUBSYSTEM IDENTIFICATION FROM CPA
          SX1    B6
          IX6    X3+X1
          ERX3   X6          READ (ADDR)
          SA6    T1          ABSOLUTE *ADDR*
          BX7    X4-X7
          SX4    X4-LSSI-1
          NZ     X7,CPE      IF SUBSYSTEM CODE NOT INITIALIZED
          NG     X4,CPE      IF CALLER NOT SUBSYSTEM
          MX2    -18
          BX4    -X2*X1
          SX6    MSFO*10B    SET MAXIMUM SFCALL OVERHEAD
          SA6    SSFE
 
*         CHECK USER JOB.
*         (X0) = -7777B.
*         (X3) = SFCALL FUNCTION WORD.
*         (X4) = LIST PROCESSING FLAG.
*         (B3) = (RA).
*         (B4) = SUBSYSTEM FL.
 
 SSF1     MX7    -6          CHECK FUNCTION CODE (FC) FOR LEGALITY
          SA1    SSFB        CHECK IF SCPA VALIDITY CHECKING NEEDED
          BX7    -X7*X3
          SA2    SSFE        DECREMENT REMAINING MONITOR TIME
          LX3    59-0
          SB5    X7          FUNCTION CODE (FC)
          TX6    X2,-SFFO
          SA6    A2
          LX1    X1,B5
          NG     X3,CPE      IF COMPLETION BIT ALREADY SET
          SX6    B5-EXIT
          SX2    B5-REGR
          ZR     X6,S16      IF *SF.EXIT* REQUEST
          LX3    59-41-59+0  EXTRACT FUNCTION PARAMETER
          BX7    -X0*X3      FP
          LX3    -6-12-6     EXTRACT SCPA
          PX7,B5 X7          SAVE FC AND FP
          SB6    X3          SCPA
          LE     B5,B1,CPE   IF ILLEGAL FC
          SB5    X7+B6
          PL     X1,SSF3     IF NO SCPA CHECKING REQUIRED
 
*         CHECK SCPA OUT OF RANGE.
 
          NZ     X2,SSF2     IF NOT *SF.REGR*
          ZR     B6,SSF3     IF NO MESSAGE ADDRESS SPECIFIED
          SB5    B6+MESL     CHECK MESSAGE LENGTH
 SSF2     LE     B6,B1,SSF20 IF SCPA .LE. 1
          NG     B5,SSF20    IF (SCPA + FP) EXCEED 17 BITS
          GT     B5,B4,SSF20 IF SCPA LWA .GT. FL
 
*         CHECK OTHER USER JOB INFORMATION.
 
 SSF3     NG     X4,SSF4     IF LIST PROCESSING IN EFFECT
          SB6    SSF21       SET RETURN ADDRESS IF INVALID EJT ORDINAL
          SB5    SSF3.1      SET NORMAL RETURN ADDRESS FOR *CUI*
          EQ     CUI         CHECK UCP IDENTIFICATION
 
 SSF3.1   NZ     X6,SSF18    IF NO MATCH ON JOB SEQUENCE NUMBER
          SX6    A1          SAVE UCP EJT ENTRY ABSOLUTE ADDRESS
          ERX3   X3          READ PARAMETER WORD
          SA6    SSFF
          NZ     X2,SSF14    IF UCP NOT AT CONTROL POINT
          SA2    CMCL        CHECK FOR STORAGE MOVE
          AX2    48
          LX2    7
          BX2    X5-X2
          ZR     X2,SXS      IF UCP JOB MOVING
          LX3    -6
          LX5    18
          BX4    X4+X5       SAVE UCP CPA
          LX1    59-6
          NG     X1,SSF14.1  IF JOB ADVANCE SET
          BX5    X3          SAVE REGISTERS
          SB5    B4
          SA2    B7+JCIW     GET SSID
          LX2    -24
          BX2    -X0*X2
          LX4    -18
          SA3    X4+SSCW
          SB4    SSF3.2      RETURN ADDRESS FOR *CSC*
          EQ     CSC         CHECK SUBSYSTEM CONNECTION
 
 SSF3.2   LX4    -18         SAVE SHIFT COUNT
          SX1    B6+
          BX3    X5          RESTORE (X5)
          BX4    X4+X1
          SB4    B5+         RESTORE (B4)
          LX4    36
 
*         CHECK IF SWPO HAS BEEN ISSUED BY REQUESTING SCP.
*         IF SO RETURN *ROLLED OUT* STATUS (RC=44).
 
 SSF4     UX1,B5 X7          EXTRACT FC
          SX5    B5-SWPI
          ZR     X5,SSF5     IF SF.SWPI FUNCTION
          BX5    X5-X5
          LX4    -18
          SA2    X4+SSCW     GET UCP CONTROL WORD
          LX4    -18
          SB6    X4
          LX4    36
          ZR     B6,SSF5     IF NO CONNECTION
          LX5    X2,B6       POSITION ROLLOUT ALLOWED FLAG
          LX5    59-4
 
*         CHECK UCPA OUT OF RANGE
 
 SSF5     SA2    SSFC        CHECK IF UCPA VALIDITY CHECKING NEEDED
          LX2    X2,B5
          LX1    X2,B1
          SX6    B5-ENDT     CHECK FOR SF.ENDT FUNCTION
          LX3    -18
          SB6    X3          UCPA
          LX3    18
          NZ     X6,SSF6     IF NOT SF.ENDT REQUEST
          SX6    B6
          NG     B6,SSF8     IF SPECIAL SF.ENDT (UCPA .LT. 0)
          NG     X5,SSF15    IF SF.SWPO ISSUED, RETURN RC44 STATUS
          ZR     B6,SSF8     IF SPECIAL SF.ENDT (UCPA = 0)
          BX7    X0*X7       CLEAR FUNCTION PARAMETER FIELD
 SSF6     NG     X5,SSF15    IF SF.SWPO ISSUED, RETURN RC44 STATUS
          PL     X2,SSF8     IF NO UCPA CHECKING REQUIRED
          PL     X1,SSF7     IF NOT EXTENDED UCPA
          MX5    2
          BX5    X5*X4       CALCULATE EXTENDED ADDRESS WORD BIAS
          SX1    B1+B1
          LX5    2
          BX1    X5-X1       0 = LIST, 1 = XLST, 2 = XRED/XWRT
          SB6    X1
          ZR     X1,CPE      IF SF.XRED/SF.XWRT IN SF.LIST
          SA5    B3          RA
          SX1    X4+B6
          IX6    X5+X1
          ERX1   X6          GET EXTENDED UCPA ADDRESS
          SA6    T2
          NG     X1,SSF8     IF EUCPA IS ECS ADDRESS
          LX1    -24         VALIDATE EXTENDED UCP CM ADDRESS
          SB6    X1
 SSF7     LX4    -18
          SA5    X4+FLSW     GET UCP RA AND FL
          LX4    18
          BX2    -X0*X5      FL/100
          MX0    -RMSK
          AX5    RSHF
          LE     B6,B1,SSF11 IF UCP ADDRESS OUT OF RANGE
          BX6    -X0*X5      UCP RA/100
          MX0    -12
          LX2    6           FL
          SX5    X7+B6       UCPA LWA + 1
          LX6    6
          IX2    X2-X5       FL - (LWA+1)
          NG     X5,SSF11    IF (UCPA + FP) EXCEED 17 BITS
          SX1    B6
          IX6    X1+X6       X6 = UCPA ABSOLUTE
          NG     X2,SSF11    IF UCPA OUT OF RANGE
 
*         EXIT TO FUNCTION PROCESSOR.
 
 SSF8     LX4    -36
          SB6    X4          SHIFT COUNT
          MX5    -3
          LX4    18
          SA2    X4+SSCW     GET SCP CONTROL WORD OF UCP
          LX4    18
          LX2    B6
          BX1    -X5*X2      WAIT RESPONSE INDICATOR FOR THIS SUBSYSTEM
          SX5    B5-2        CHECK FUNCTION CODE
          LX5    -2
          SX3    X3+         EXTRACT SCPA
          SB5    X5-MXSF
          PL     B5,CPE      IF ILLEGAL FUNCTION CODE
          NZ     B6,SSF8.1   IF VALID *SSCW*
          SX1    B0+         CLEAR WAIT RESPONSE INDICATORS
          SX2    B0+         CLEAR *SSCW*
 SSF8.1   JP     B5+SSFA+MXSF  PROCESS FUNCTION
          SPACE  4
*         EXIT TO FUNCTION PROCESSOR WITH -
*
*         (T2) = ABSOLUTE ADDRESS OF EXTENDED ADDRESS WORD.
*                IF EXTENDED ADDRESS FUNCTION.
*         (A2) = *SSCW* ADDRESS IN UCP CPA.
*         (T1) = ABSOLUTE ADDRESS OF FUNCTION PARAMETER WORD.
*         ((B3)) = SUBSYSTEM RA.
*         (B4) = SUBSYSTEM FL.
*         (B5) = JUMP POSITION IN TABLE.
*         (B6) = SUBSYSTEM INDICATOR SHIFT COUNT.
*         (X0) = -7777B.
*         (X1) = WAIT RESPONSE INDICATORS FOR THIS UCP.
*         (X2) = *SSCW* WORD OF UCP CPA SHIFTED TO SCP BYTE.
*         (X3) = SCPA (RELATIVE ADDRESS).
*         (X4) = LIST PROCESSING FLAG.
*T        1/L,1/E,1/A,3/0,18/ INDX,18/ CPA,18/ SFA
*                L = SET IF LIST PROCESSING IN EFFECT (SF.LIST
*                    OR SF.XLST FUNCTION).
*                E = SET IF EXTENDED LIST PROCESSING IN EFFECT
*                    (SF.XLST WITH 2 WORDS PER LIST ENTRY).
*                A = SET IF NO ADVANCE ON FUNCTIONS IN LIST.
*                INDX = SHIFT COUNT.
*                CPA = UCP CONTROL POINT ADDRESS.
*                SFA = CURRENT FUNCTION RELATIVE ADDRESS.
*                    OR LIST ENTRY).
*         (X6) = UCPA ABSOLUTE.
*         (X7) = 12/FC,30/ ,18/FP
*                FC = FUNCTION CODE.
*                FP = FUNCTION PARAMETER WORD.
*
*         FUNCTION JUMP TABLE. TWO FUNCTIONS PER WORD.
 
 SSFA     BSS    0
          LOC    0
+         PL     X5,S02      SF.REGR (02)
          EQ     SSF19       SF.TIM (04) - NOT IMPLEMENTED
+         PL     X5,S06      SF.ENDT (06)
          EQ     S10         SF.READ (10)
+         PL     X5,S12      SF.STAT (12)
          EQ     S10         SF.WRIT (14)
+         PL     X5,S16      SF.EXIT (16)
          EQ     CPE         SF.INUF (20) - NOT IMPLEMENTED
+         PL     X5,CPE      SF.RTUF (22) - NOT IMPLEMENTED
          EQ     S24         SF.SWPO (24)
+         PL     X5,S24      SF.SWPI (26)
          EQ     S30         SF.SLTC (30)
+         PL     X5,S30      SF.CLTC (32)
          EQ     S34         SF.LIST (34)
+         PL     X5,CPE      SF.RERN (36) - NOT IMPLEMENTED
          EQ     S40         SF.XRED (40)
+         PL     X5,S42      SF.XLST (42)
          EQ     S40         SF.XWRT (44)
          PL     X5,S46      SF.CPID (46)
          EQ     CPE                 (50) - NOT IMPLEMENTED
          LOC    *O
 MXSF     EQU    *-SSFA
 
*         FUNCTION 02 - SEND MESSAGE TO USER JOB.
 
 S02      MX6    -4
          SA1    A2-SSCW+JCIW CHECK SUBSYSTEM CONNECTED WITH UCP
          BX7    -X6*X2
          LX1    36
          ZR     X7,SSF16    IF UCP NOT ESTABLISHED WITH SUBSYSTEM
          BX2    -X0*X1      CHECK IF UCP IS A SUBSYSTEM
          SX1    X2-LSSI-1
          NG     X1,S022     IF UCP NOT A SUBSYSTEM
 
*         NOTE - IF TWO SUBSYSTEMS ARE CONNECTED TO ONE ANOTHER,
*         THE UCP CANNOT ISSUE AN SF.REGR REQUEST ON THE SCP.
 
          SB5    B4          SAVE REGISTERS
          BX5    X3
          SA3    B7+SSCW
          SB4    S021        RETURN ADDRESS FOR *CSC*
          EQ     CSC         CHECK SUBSYSTEM CONNECTION
 
 S021     SA3    A3          CHECK SCP CONNECTED TO UCP
          LX3    B6
          MX6    -4
          BX2    -X6*X3
          BX3    X5          RESTORE REGISTERS
          SB4    B5
          ZR     B6,S022     IF NOT CONNECTED
          SX5    RC64        * UCP IS ESTABLISHED WITH RECEIVER.*
          NZ     X2,SSF12    IF SUBSYSTEM (SCP) ESTABLISHED WITH UCP
 S022     SX5    A1-JCIW     UCP CP ADDRESS
          EQ     SSF9        FORMAT 1MA REQUEST
 
*         FUNCTION 06 - COMPLETE USER REQUEST.
 
 S06      ZR     X3,S062     IF NO UCP ACCOUNT PROCESSING
          SB5    X3          VALIDATE ADDRESS
          SA5    B3          RA OF SCP
          LT     B5,B1,SSF20 IF SCPA .LT. 0
          SB5    B5+4        ADD PARAMETER BLOCK LENGTH
          GT     B5,B4,SSF20 IF PARAMETER BLOCK OUTSIDE FL
          IX2    X5+X3       SET ABSOLUTE PARAMETER BLOCK ADDRESS
          SA6    S06A        SAVE UCPA ABSOLUTE
          MX7    -18         GET UCP CP ADDRESS
          LX7    18
          BX7    -X7*X4
          AX7    18
          BX6    X4          SAVE LIST PROCESSING FLAG
          SA6    S06B
          SX6    B3          SAVE SUBSYSTEM RA ADDRESS
          LX6    18
          SX4    B4          SAVE SUBSYSTEM FL
          BX6    X6+X4
          LX6    18
          SX4    B6          SAVE SHIFT COUNT
          BX6    X6+X4
          SA6    S06C
          SX6    B7          SAVE SCP CP ADDRESS
          SA6    S06D
          BX5    X1          SAVE WAIT RESPONSE INDICATORS
          SB7    X7          SET UCP CP ADDRESS
          SB3    S061        SET EXIT ADDRESS
          EQ     IAA         INCREMENT AUC ACCUMULATOR
 
 S061     SA2    B7+SSCW     RESTORE REGISTERS
          SA3    S06D
          SB7    X3
          SA3    S06C
          SB6    X3
          AX3    18
          SB4    X3
          AX3    18
          SB3    X3
          SA4    S06B
          SA1    S06A
          BX6    X1
          BX1    X5
          MX0    -12
          LX2    B6
          NE     B5,B0,SSF22 IF EXCESSIVE AUC INCREMENT
 S062     SX3    B1
          IX7    X2-X3       DECREMENT WAIT RESPONSE INDICATORS
          PL     X6,S063     IF ONLY ONE FUNCTION TO SET COMPLETE
          LX3    3
          BX5    X3*X2       LONG TERM CONNECTION INDICATOR
          LX5    -3
          IX1    X1+X5       COUNT OF CONNECTION INDICATORS
          LX3    X1
          BX7    X0*X2       CLEAR ALL CONNECTION INDICATORS
 S063     ZR     X1,SSF16    IF NO CONNECTION INDICATORS SET
          MX5    -4
          BX1    -X5*X7      NEW CONNECTION INDICATORS
          NZ     X1,S064     IF STILL CONNECTIONS TO THIS SCP
          BX7    X0*X2       CLEAR ALL CONNECTION INDICATORS
 S064     SB5    60
          SB5    B5-B6
          LX7    B5          UPDATE *SSCW*
          SA7    A2+
          SA1    B7+SSOW     UPDATE OUTSTANDING CONNECTION COUNT
          IX7    X1-X3
          BX5    X5-X5       REPLY CODE (NO ERRORS)
          SA7    A1+
          SB5    A2-SSCW     UCP CONTROL POINT ADDRESS
          SB6    -B5
          ZR     X6,SSF12    IF NO COMPLETION BIT TO SET
          NG     X6,SSF12    IF NO COMPLETION BIT TO SET
          ERX1   X6          SET COMPLETION BIT
          BX7    X3+X1
          EWX7   X6
          TIC    DCPC        INVALIDATE CACHE ON OTHER CPU, IF PRESENT
          EQ     SSF12       COMPLETE REQUEST
 
 S06A     CON    0           SAVE UCPA ABSOLUTE
 S06B     CON    0           SAVE LIST PROCESSING FLAG
 S06C     CON    0           SAVE B REGISTERS
 S06D     CON    0           SAVE SCP CP ADDRESS
 
*         FUNCTIONS 10 AND 14 - READ/WRITE DATA.
 
 S10      ZR     X1,SSF16    IF NO WAIT RESPONSE INDICATORS SET
          SX5    B5+MXSF-WRIT/4+1
          SX7    X7          WORD COUNT
          SA1    B3          RA OF SCP
          LX6    30
          IX1    X1+X3       ABSOLUTE SCPA
          IX6    X6+X1       30/UCPA ABS, 30/SCPA ABS
          SX1    X7-MAXB-1   CHECK TRANSFER SIZE
          NG     X1,S401     IF TRANSFER SIZE NOT TOO LARGE
          SX5    RC62        * WORD TRANSFER TOO LONG.*
          EQ     SSF12       SET COMPLETE BIT AND ERROR CODE
 
*         FUNCTIONS 40 AND 44 - EXTENDED READ/WRITE DATA.
 
 S40      ZR     X1,SSF16    IF NO WAIT RESPONSE INDICATORS SET
          SX5    B5+MXSF-XWRT/4+1  CHECK FOR READ OR WRITE FUNCTION
          SX7    X7          WORD COUNT
          SA2    T2
          ERX2   X2          VALIDATE SCPA CM ADDRESS
          LX1    X2,B1
          BX3    X1*X2
          SB5    X2+         ESCPA
          NG     X3,CPE      IF BOTH ECS ADDRESSES
          SX3    X2
          TNG    X1,(/SCPUEC/SFE1,UEC,/MONITOR/SSF20)  IF SCP ECS
          SB6    B5+X7       VALIDATE SCP EXTENDED CM ADDRESS
          LE     B5,B1,SSF20 IF ESCPA .LE. 1
          SA1    B3
          LX6    30
          IX1    X1+X3       ABSOLUTE SCP CM ADDRESS
          IX6    X6+X1       UCP/SCP
          GT     B6,B4,SSF20 IF ESCPA + FP .GT. FL
          TNG    X2,(/SCPUEC/SFE,UEC,/MONITOR/SSF11)  IF UCP ECS
 S401     SB6    S402        SET RETURN ADDRESS FOR *CWT*
          EQ     CWT         CALCULATE WORD TRANSFER SIZE
 
 S402     BX2    X4          SAVE LIST FLAG
          NZ     X5,S403     IF SF.READ
          LX6    30          REVERSE PARAMETERS FOR WRITE
 S403     MX5    30
          BX1    -X5*X6      ADDRESS TO MOVE TO
          LX6    30
          BX0    -X5*X6      ADDRESS TO MOVE FROM
          IX1    X0-X1       DIFFERENCE
          SB6    S404        SET *MSM*/*MSR* RETURN ADDRESS
          SX5    B4          SAVE TRANSFER SIZE
          TJP    (/CME/MSR,CME,/MONITOR/MSM,CMUMTR,/MONITOR/MSR)
 
*         RESTORE REGISTERS.  UPDATE REMAINING WORD COUNT AND
*         SCP/UCP ADDRESSES FOR EXTENDED MODE READ/WRITE.
*
*         (X2) = LIST PROCESSING FLAG.
*         (X3) = SCP FL.
*         (X5) = TRANSFER SIZE.
 
 S404     TIC    DCPC        INVALIDATE CACHE ON OTHER CPU, IF PRESENT
          BX4    X2          RESTORE LIST PROCESSING FLAG
          SB4    X3          RESTORE SUBSYSTEM FL
          SA1    B3          RA
          SX2    X4          RELATIVE ADDRESS
          IX2    X2+X1
          ERX1   X2          GET FUNCTION PARAMETER WORD
          MX2    -6
          BX2    -X2*X1      FUNCTION CODE
          MX0    -12
          SX2    X2-XRED     CHECK FOR EXTENDED MODE READ/WRITE
          NG     X2,SSF19    IF NOT EXTENDED READ/WRITE
          LX1    18          DECREMENT WORD COUNT
          IX6    X1-X5
          BX3    -X0*X6      CHECK IF TRANSFER COMPLETE
          SA2    T2
          ERX2   X2          ADVANCE UCP AND SCP ADDRESSES
          LX6    -18
          IX7    X2+X5
          SA2    B3          RA
          SX0    X4          REL ADDRESS
          IX2    X2+X0
          EWX6   X2
          MX0    -12
          LX5    24
          IX7    X7+X5
          SA2    T2
          TIC    DCPC        INVALIDATE CACHE ON OTHER CPU, IF PRESENT
          EWX7   X2
          MX2    1
          ZR     X3,SSF19    IF TRANSFER COMPLETE
          LX2    -2
          BX4    X4+X2       SET NO ADVANCE ON LIST
          EQ     SSF19       SET COMPLETE BIT AND NO ERROR
 
*         FUNCTION 12 - RETURN STATUS OF USER JOB.
*
*         ENTER HERE TO COMPLETE FUNCTION 46 (SF.CPID) SUBFUNCTION TO
*         RETURN APPLICATION ACCESS LEVEL TO A PRIVILEGED USER.
*         (B4) = 1.
 
 S12      MX6    -4          RETURN LONG TERM CONNECTION, WAIT RESPONSE
          SA1    SSFF        GET UCP EJT ENTRY ADDRESS
          SA1    X1+SCLE     GET JOB ORIGIN
          LX1    -48
          BX1    -X6*X1
          BX5    -X6*X2      1/LONG TERM CONNECTION, 3/WAIT RESPONSE
 
*         CHECK FOR PRIVILEGED PROGRAM AND PRIVILEGED USER.
*         A PRIVILEGED PROGRAM IS ONE WITH AN SSJ= ENTRY POINT
*         OR A SUBSYSTEM.  A PRIVILEGED USER IS A SYSTEM
*         ORIGIN JOB OR A USER WITH SYSTEM ORIGIN PRIVILEGES
*         WHEN THE SYSTEM IS IN *DEBUG* MODE.
 
          BX7    X3
          SX3    X1-SYOT     CHECK FOR SYSTEM ORIGIN JOB
          SA1    B3          RELATIVE ADDRESS
          IX7    X7+X1       SCPA
          SA2    A2+JCIW-SSCW  CHECK FOR SUBSYSTEM IDENTIFICATION
          SA1    A2+SEPW-JCIW  CHECK FOR SSJ= ENTRY POINT
          LX2    36
          BX6    -X0*X2
          SA2    A2+AACW-JCIW  CHECK FOR SYSTEM ORIGIN PRIVILEGES
          LX1    59-50
          SX6    X6-LSSI-1
          BX1    -X6+X1
          PL     X1,S121     IF NOT SUBSYSTEM AND NOT SSJ=
          SX5    X5+40B      SET PRIVILEGED PROGRAM STATUS
 S121     ZR     X3,S122     IF *SYOT* JOB
          SA1    SSTL        CHECK FOR *DEBUG* MODE
          LX2    59-4
          LX1    59-12
          BX3    X1*X2       CHECK FOR *SYOT* PRIVILEGES AND *DEBUG*
          BX3    -X3
 S122     NG     X3,S123     IF NOT PRIVILEGED USER
          SX5    X5+20B      SET PRIVILEGED USER STATUS
 S123     EQ     B4,B1,S124  IF SF.CPID SUBFUNCTION
          SA1    B3          RA
          SX2    X4          RELATIVE ADDRESS
          IX2    X2+X1
          ERX1   X2          RETURN STATUS INFORMATION
          LX1    18
          BX1    X0*X1
          BX6    X1+X5
          LX6    -18
          EWX6   X2
          TIC    DCPC        INVALIDATE CACHE ON OTHER CPU, IF PRESENT
          EQ     SSF19       SET COMPLETE BIT AND NO ERROR
 
*         COMPLETE FUNCTION 46 (SF.CPID) WITH *FP* = 1.
 
 S124     SB4    X5          SAVE PRIVILEGES
          SB3    A2          SAVE PRIVILEGES ADDRESS
          SB6    CPE         SET ERROR ADDRESS FOR *CUI*
          SB5    S125        SET RETURN ADDRESS FOR *CUI*
          EQ     CUI         GET JSN
 
 S125     SA2    B3+         RESTORE PRIVILEGES ADDRESS
          MX6    24
          BX6    X6*X1       JSN
          SA1    A2+AALW-AACW  ADD APPLICATION ACCESS LEVEL
          MX3    -6
          BX1    -X3*X1
          BX6    X6+X1
          SX5    B4          SET PRIVILEGES
          LX5    6
          BX6    X6+X5
          EWX6   X7
          EQ     SSF19       SET COMPLETE BIT AND NO ERROR
 
*         FUNCTION 16 - EXIT FROM SYSTEM CONTROL POINT STATUS.
 
 S16      SB6    S16         SET RETURN ADDRESS FOR *RSI*
          EQ     RSI         RETURN SUBSYSTEM IDENTIFICATION
 
*         RETURN FROM *RSI* WITH SUBSYSTEM INFORMATION.
 
+         SX6    B1          CLEAR SUBSYSTEM ACTIVE FLAG
          SB6    X3+11
          LX6    B6
          BX6    -X6*X2
          SA1    B7+SSOW     CHECK FOR OUTSTANDING CONNECTION
          SA6    A2
          SA3    B3
          SX6    SSIW
          IX3    X3+X6
          BX6    X6-X6
          BX5    -X0*X1
          EWX6   X3          CLEAR SUBSYSTEM IDENTIFICATION WORD
          ZR     X5,SSF19    IF SCP HAS NO OUTSTANDING CONNECTIONS
          SA5    B3+B1       ADDRESS OF RA+1
          MX7    1
          ERX3   X5          READ RA+1
          LX7    40-59
          BX7    X7+X3
          SX2    4           SET *1MA* FUNCTION CODE
          EWX7   X5
          SX3    -B1         INDICATE NO DATA FOR MESSAGE BUFFER
          SX5    B7          SCP CPA
          EQ     SSF9        CALL *1MA*
 
*         FUNCTION 24 AND 26 - SET/CLEAR ROLLOUT ALLOWED.
 
 S24      SX3    1S4         SET ROLLOUT ALLOWED BIT
          ZR     X2,SSF16    IF NOT CONNECTED
          BX7    X3+X2
          LX2    X1
          SB5    B5+MXSF-SWPO/4+1
          SA1    A2+STSW-SSCW
          BX5    X5-X5       REPLY CODE COMPLETE, NO ERRORS
          ZR     B5,S241     IF SWAPOUT ALLOWABLE (SF.SWPO) REQUEST
          LX1    59-29
          NG     X1,SSF14.1  IF USER JOB IN PROCESS OF ROLLOUT
          BX6    -X3*X7      CLEAR ROLLOUT ALLOWED INDICATOR
          SB5    60
          SB5    B5-B6
          LX6    B5
          SA6    A2
          EQ     SSF12       COMPLETE REQUEST
 
 S241     ZR     X2,SSF16    IF NO WAIT RESPONSE INDICATORS SET
          SA1    A2+FLSW-SSCW  READ UCP STATUS WORD IN CP AREA
          BX2    -X0*X1
          SB5    60
          SB5    B5-B6
          LX7    B5
          SA7    A2          SET ROLLOUT ALLOWED INDICATOR
          MX6    -RMSK
          AX1    RSHF
          BX6    -X6*X1
          LX6    6
          ZR     X2,SSF12    IF UCP HAS NO FL
          SA1    RC          *RCLP*
          BX3    X1
          SX1    B1
          IX6    X6+X1
          ERX1   X6          READ (RA+1)
          BX3    X3-X1
          AX3    36
          NZ     X3,SSF12    IF UCP NOT IN RECALL ON *CALLSS* REQUEST
          SB5    5
          MX1    1
          LX1    -1          LONG TERM CONNECTION MASK
          SX3    176B        SUBSYSTEM ID MASK
          BX1    X1+X3
          MX3    5           ROLLOUT AND WAIT RESPONSE MASK
          LX7    7
 S242     BX7    -X1*X7      CLEAR LTC FLAG
          PL     X7,S243     IF NO ROLLOUT ALLOWED
          BX7    -X3*X7      CLEAR ROLLOUT AND WAIT RESPONSE
 S243     LX7    12
          SB5    B5-B1
          NZ     B5,S242     IF MORE BYTES TO CHECK
          NZ     X7,SSF12    IF ANY WAIT RESPONSE INDICATORS SET
          SX6    B1
          SA1    A2+JCIW-SSCW  CHECK IF UCP IS SUBSYSTEM
          LX1    36
          BX7    -X0*X1
          SB5    X7-LSSI-1
          PL     B5,SSF12    IF UCP IS A SUBSYSTEM
          SX5    A2-SSCW     UCP CP ADDRESS
          LX6    29-0
          BX3    X3-X3
          SA6    SSFG
          EQ     SSF9        CALL *1MA*
 
*         FUNCTIONS 30 AND 32 - SET/CLEAR LONG TERM CONNECTION.
 
 S30      SX6    1S3
          BX7    X6*X2       LONG TERM CONNECTION INDICATOR
          PL     X5,S301     IF CLEAR LTC FUNCTION
          SX3    B1+
          ZR     X1,SSF16    IF WAIT RESPONSE NOT SET
          SX5    RC57        * CONNECTION PREVIOUSLY ESTABLISHED.*
          NZ     X7,SSF12    IF LTC ALREADY SET
          EQ     S302        CONTINUE
 
 S301     SX3    -1
          SX5    RC61        * CONNECTION NOT PREVIOUSLY ESTABLISHED.*
          ZR     X7,SSF12    IF LTC ALREADY CLEAR
 S302     LX5    X1
          SA1    B7+SSOW     INCREMENT/DECREMENT CONNECTION COUNT
          IX7    X1+X3
          BX6    X6-X2       SET/CLEAR LONG TERM CONNECTION
          SA7    A1
          LX7    X6
          NZ     X5,S303     IF WAIT RESPONSE REMAINING FOR SCP
          BX6    X0*X7       CLEAR CONNECTIONS TO THIS SCP
 S303     SB5    60
          SB5    B5-B6
          LX6    B5          UPDATE *SSCW*
          SA6    A2
          EQ     SSF19       COMPLETE
 
*         FUNCTION 42 - EXTENDED LIST PROCESSING (2 WORDS PER
*         LIST ENTRY).
 
 S42      MX2    1           SET EXTENDED LIST PROCESSING FLAG
          LX2    -1
          BX4    X2+X4
*         EQ     S34         INITIATE LIST PROCESSING
 
*         FUNCTION 34 - PROCESS LIST OF REQUESTS.
 
 S34      SX5    RC40        * AT LEAST ONE ERROR ENCOUNTERED IN LIST.*
          NG     X4,SSF12    IF NESTED SF.LIST FUNCTION
          SX5    RC42        * SCPA NOT WITHIN SUBSYSTEM FL.*
          UX7    X7          EXTRACT FUNCTION PARAMETER WORD (FP)
          MX2    1           SF.LIST PROCESSING IN PROGRESS FLAG
          ZR     X7,SSF12    IF NO ENTRIES IN LIST
          SA1    B3+         RA
          IX1    X3+X1
          SX5    X3
          ERX1   X1          READ FILE SF.XXXX PARAMETER WORD
          BX4    X2+X4
          MX6    -54
          SA3    T1
          BX7    X3
          ERX3   X3          CLEAR LIST REPLY CODE
          MX2    42          SAVE RELATIVE ADDRESS OF FIRST LIST ENTRY
          BX6    -X6*X3
          BX4    X2*X4
          LX3    X1
          BX5    -X2*X5
          EWX6   X7
          BX4    X4+X5
          EQ     SSF1        PROCESS FIRST FUNCTION IN LIST
 
*         FUNCTION 46 - RETURN USER JOB IDENTIFICATION.
 
 S46      SB5    X3+2        VALIDATE SCPA CM ADDRESS
          GE     B5,B4,SSF20 IF SCPA LWA .GE. FL
          SB4    X7
          ZR     B4,S461     IF *FP* EQUALS 0
          NE     B4,B1,SSF19  IF *FP* NOT EQUAL TO 1
          EQ     S12         VALIDATE SCPA
 
 S461     SA1    A2-SSCW+PFCW  FIND USER FAMILY NAME
          LX1    -12
          MX2    -12
          BX2    -X2*X1
          CX1    X2,EST      CONVERT EST ORDINAL TO OFFSET
          TA1    X1+EQDE,EST READ EST ENTRY
          BX1    -X0*X1
          LX1    3
          SA1    X1+PFGL     READ FAMILY NAME FROM MST
          MX2    42
          BX6    X2*X1
          SA1    B3          RA
          IX5    X1+X3       ABSOLUTE SCPA
          EWX6   X5          RETURN FAMILY NAME
          SA1    A2+UIDW-SSCW  USER NUMBER FROM CP AREA
          SX3    B1
          IX5    X5+X3
          BX6    X2*X1
          EWX6   X5          RETURN USER NUMBER
          IX5    X5+X3
          SA1    A2-SSCW+AACW  GET ACCESS WORD
          MX6    -1
          LX1    0-18
          BX6    -X6*X1      PROVIDE *NVE* ACCESS WORD BIT
          EWX6   X5          RETURN VALIDATION WORD
          EQ     SSF19       SET COMPLETE BIT AND NO ERROR
          SPACE  4,10
*         THESE FUNCTIONS ARE PROCESSED BY 1MA.
*         FUNCTION 02 - SEND DAYFILE MESSAGE AND/OR ABORT USER JOB.
*         FUNCTION 16 - EXIT FROM SCP STATUS.
*         FUNCTION 24 - SWAP OUT USER JOB.
*
*         (B3) = (RA).
*         (T1) = ABSOLUTE ADDRESS OF SF.XXXX FUNCTION.
*         (X3) .LT. 0, IF NO DATA TO BE PASSED IN MESSAGE BUFFER.
*              = 0, IF ONLY FUNCTION PARAMETER WORD AND UCP JOB
*                IDENTIFIER TO BE PASSED IN MESSAGE BUFFER.
*              = MESSAGE ADDRESS (RELATIVE TO SCP) IF MESSAGE TO
*                BE PASSED IN MESSAGE BUFFER IN ADDITION TO
*                FUNCTION PARAMETER WORD AND UCP JOB IDENTIFIER.
*         (X5) = CP ADDRESS.
*         (X4) = LIST PROCESSING FLAG.
 
 SSF9     SA1    B3          ADDRESS OF RA
          BX7    X1
          SA1    T1
          IX7    X1-X7       RELATIVE ADDRESS OF PARAMETER WORD
          SA1    B7+JCIW     GET SSID
          LX1    -24
          BX6    -X0*X1
          SX0    X6-LSSI     SET INDEX FOR *1MA*
          LX0    18
          BX0    X7+X0
          NG     X3,SSC15    IF NO DATA TO PASS
          SB3    SSF9.1      SET *ACB* RETURN ADDRESS
          EQ     ACB         ASSIGN COMMUNICATION BUFFER
 
 SSF9.1   ZR     X1,SXS      IF NO BUFFER AVAILABLE
          BX7    X1          SET PARAMETER WORD
          SB6    X1
          SA7    APQA
          SA1    T1
          SX7    B1
          IX7    X1+X7
          SA1    RA          GET RA
          SX4    X4          LIST PROCESSING FLAG
          IX1    X4+X1       ABSOLUTE ADDRESS OF CURRENT SFCALL
          ERX1   X1          CURRENT SFCALL FUNCTION
          BX6    X1
          SA6    B6+B1       STORE IN COMMUNICATION BUFFER
          ERX4   X7          JOB IDENTIFIER
          LX7    X4
          SX2    B1+B1       SET *1MA* FUNCTION CODE
          SA7    A6+B1
          ZR     X3,SSC15    IF NO MESSAGE FOR MESSAGE BUFFER
          SA4    RA          GET RA
          IX7    X4+X3
          ERX4   X7
          SB6    MESL        SET MESSAGE LENGTH
 
*         SET MESSAGE INTO MONITOR COMMUNICATION BUFFER.
 
 SSF10    BX6    X4
          SB6    B6-B1
          SA6    A6+B1
          SX4    B1
          IX7    X7+X4
          ERX4   X7
          NZ     B6,SSF10    IF MORE DATA TO PASS
          EQ     SSC15       CALL *1MA*
 
 SSF11    SX5    RC43        * UCP CM/ECS ADDRESS OUT OF RANGE.*
          SB6    B1          INDICATE NO ERROR
          MX0    -12
*         EQ     SSF12
 
*         COMPLETE.
*
*         (T1) = ABSOLUTE ADDRESS OF FUNCTION PARAMETER WORD.
*         (X0) = -7777B.
*         (X4) = LIST PROCESSING FLAG.
*         (X5) = REPLY CODE.
*         (B6) = -CPA, IF SF.ENDT REQUEST.
*              = -1, IF FATAL ERROR.
*              .GE. 0 IF NO ERROR CONDITION.
 
 SSF12    SA3    T1
          ERX1   X3          SET COMPLETION AND RETURN STATUS
          MX6    -54
          LX5    54          RC
          SX2    B1
          BX7    -X6*X1      CLEAR STATUS
          SB5    X4          SAVE LAST FUNCTION ADDRESS
          PL     X4,SSF13    IF LIST PROCESSING NOT IN EFFECT
 
*         PROCESS NEXT FUNCTION IN LIST.
 
          BX3    X1
          SX7    X4          RELATIVE ADDRESS
          SA1    B3+         RA
          IX7    X7+X1
          SA7    T2
          ERX1   X7          GET CURRENT ENTRY IN LIST
          BX7    X3
          LX3    X4
          LX3    2
          NG     X3,SSF13    IF NO ADVANCE ON LIST FUNCTION
          LX7    -6
          BX3    X2*X3       GET EXTENDED LIST INDICATOR
          IX3    X3+X2       LIST ADDRESS INCREMENT
          IX7    X7+X3       POINT SCPA TO NEXT ENTRY IN LIST
          LX7    6+18
          IX7    X7-X2       DECREMENT NUMBER OF FUNCTIONS LEFT IN LIST
          BX1    -X6*X1      CLEAR STATUS
          IX4    X4+X3       ADVANCE LIST ABSOLUTE ADDRESS
          BX3    -X0*X7      NUMBER OF ENTRIES REMAINING IN LIST
          BX1    X5+X1       SET STATUS IN SF.XXXX
          BX6    X1+X2       SET SF.XXXX COMPLETE BIT
          LX7    -18
          SX5    RC40        * AT LEAST ONE ERROR ENCOUNTERED IN LIST.*
          SA1    T2
          EWX6   X1
          LX5    54
          NG     X6,SSF13    IF ERRORS ENCOUNTERED
          SX5    B0+
          ZR     X3,SSF13    IF NO MORE ENTRIES IN LIST
          SA1    SSFE        CHECK IF MONITOR MODE TIME EXHAUSTED
          TX3    X1,-SFFO    SFCALL FUNCTION OVERHEAD
          NG     X3,SSF13    IF MONITOR MODE TIME EXHAUSTED
          SA1    B3
          SX3    X4
          IX1    X3+X1       RA + RELATIVE LIST ADDRESS
          ERX3   X1          READ NEXT ENTRY
          SA1    T1
          EWX7   X1          UPDATE SF.LIST FUNCTION WORD
          PL     B6,SSF1     IF NOT FATAL ERROR OR SF.ENDT
 SSF13    BX6    X5+X7       INSERT REPLY CODE
          BX6    X2+X6       SET COMPLETION BIT
          SA1    T1
          BX7    X7-X7
          EWX6   X1
          PL     B6,MTRP     IF NO ERROR
          SA1    B3
          SX2    B5
          IX1    X2+X1
          ERX1   X1          GET FUNCTION JUST PROCESSED
          SB6    -B6
          LE     B6,B1,CPE   IF FATAL ERROR
 
*         THE *SF.ENDT* REQUEST ENTERS HERE TO CHECK TO SEE IF THE
*         UCP IS IN RECALL ON THIS REQUEST.
 
          SA3    B3+B1
          EWX7   X3          CLEAR (RA+1)
          SA2    RC          CHECK *RCLP* REQUEST
          BX7    X1
          AX1    18+6
          SA4    B6+FLSW     READ UCP RA
          SX3    X1          GET UCPA
          BX2    X3+X2
          BX3    -X0*X4
          MX0    -RMSK
          AX4    RSHF
          BX4    -X0*X4
          MX0    -12
          LX4    6
          ZR     X3,MTRX     IF NO UCP FL
          LX0    18
          SX3    B1
          IX3    X3+X4
          ERX3   X3          READ UCP (RA+1)
          BX3    X0*X3
          BX6    X2-X3
          LX7    59-42
          NZ     X6,MTRX     IF NO RECALL FOR THIS REQUEST
          SA1    B6+STSW     CHECK CPU STATUS
          MX2    -3
          LX1    3
          BX2    -X2*X1
          SX2    X2-XCPS
          NZ     X2,MTRX     IF NOT *X* STATUS
          SB3    MTRX        SET *RCC* RETURN ADDRESS
          EQ     RCC         RECALL CPU
 
 SSF14    UX3,B5 X7          GET FUNCTION CODE
          LX1    59-6
          SX3    B5-SWPI
          NZ     X3,SSF14.1  IF NOT SF.SWPI
          NG     X1,SSF14.1  IF JOB ADVANCE SET
          LX1    59-0-59+6
          NG     X1,SSF14.1  IF JOB EJT INTERLOCK SET
          SX3    X2-SIJS+EXJS
          LX1    0-59
          LX3    1
          SX7    X2-ROJS+EXJS
          ZR     X7,SSF14.2  IF UCP JOB STATUS = SCHEDULER ROLLOUT
          SX7    X2-TOJS+EXJS
          ZR     X7,SSF14.2  IF UCP JOB STATUS = TIMED/EVENT ROLLOUT
          SX7    X2-SOJS+EXJS
          ZR     X7,SSF14.2  IF UCP JOB STATUS = SCP ROLLOUT
          SX5    RC46        *SWAP-IN REQUEST TEMPORARILY PROHIBITED.*
          NZ     X3,SSF12    IF UCP JOB STATUS NOT SCP ROLLIN
 SSF14.1  SX5    RC44        * USER JOB SWAPPED OUT.*
          SB6    B1+         INDICATE NO FATAL ERROR
          EQ     SSF12       SET REPLY CODE
 
 SSF14.2  IX6    X1-X3       CHANGE JOB STATUS TO SCP ROLLIN
          SA5    B3          GET RA
          SA3    T1          GET ABSOLUTE ADDRESS OF PARAMETER BLOCK
          SA2    B7+JCIW     GET SUBSYSTEM IDENTIFICATION
          SA6    A1
          LX2    36
          IX6    X3-X5       RELATIVE ADDRESS OF PARAMETER WORD
          BX2    -X0*X2
          LX6    12
          SA1    A1+B1       CHANGE SCHEDULING DATA IN EJT ENTRY
          ERRNZ  SCHE-JSNE-1  CODE DEPENDS ON VALUE
          MX3    30
          BX6    X6+X2
          BX1    X3*X1
          BX6    X6+X1
          SA6    A1
          MX6    59
          SA1    A1+SCLE-SCHE  CLEAR FORCED ROLLOUT FLAG
          LX6    53-0
          SB5    B7          (B5) = CP ADDRESS FOR *SSC*
          BX6    X6*X1
          SA6    A1
          EQ     SSC18       EXIT
 
 SSF15    SA1    SSFC        CHECK CONNECTIONS REQUIRED FOR FUNCTION
          UX2,B5 X7
          LX1    B5
          PL     X1,SSF14.1  IF NO CONNECTION CHECKING NECESSARY
          LX4    -18
          SA2    X4+SSCW     GET UCP CONTROL WORD
          LX4    -18
          SB6    X4          SHIFT COUNT
          LX4    36
          MX6    -4
          LX2    B6
          BX6    -X6*X2
          ZR     B6,SSF16    IF NO CONNECTION
          NZ     X6,SSF14.1  IF CONNECTIONS ESTABLISHED
 SSF16    SX5    RC63        * UCP NOT ESTABLISHED WITH SUBSYSTEM.*
          EQ     SSF12       SET REPLY CODE
 
 SSF18    SX5    RC45        * USER JOB IS NOT IN SYSTEM.*
          EQ     SSF12       SET REPLY CODE
 
 SSF19    BX5    X5-X5       RC = COMPLETE, NO ERRORS
          SB6    B1
          EQ     SSF12       COMPLETE REQUEST
 
 SSF20    SX5    RC42        * SCP CM/ECS ADDRESS OUT OF RANGE.*
          SB6    -B1         SET FATAL ERROR
          MX0    -12
          EQ     SSF12       COMPLETE REQUEST
 
 SSF21    SX5    RC41        * JOB IDENTIFIER INVALID.*
          EQ     SSF12       COMPLETE REQUEST
 
 SSF22    SX5    RC67        * EXCESSIVE ACCUMULATOR INCREMENT.*
          EQ     SSF12       COMPLETE REQUEST
 
 
*         TABLE OF FUNCTIONS WHICH REQUIRE SCPA VALIDITY CHECKING.
*
*         2 BITS PER SFCALL FUNCTION - 1/A, 1/R
*         A      IF SET, SCPA VALIDATION IS REQUIRED.
*         R      RESERVED.
*
*         NOTE - INSTALLATION RESERVED SFCALL FUNCTIONS (70-76)
*         SHOULD USE ADDITIONAL VALIDATION WORD.
 
 SSFB     BSS    0
          POS    60-REGR     SF.REGR
          VFD    1/1
          POS    60-READ     SF.READ
          VFD    1/1
          POS    60-WRIT     SF.WRIT
          VFD    1/1
          POS    60-LIST     SF.LIST
          VFD    1/1
          POS    60-XLST     SF.XLST
          VFD    1/1
          POS    60-CPID     SF.CPID
          VFD    1/1
          POS    1
          VFD    1/0         AVOID *PASS* INSTRUCTIONS
          BSS    0           FORCE UPPER
 
 
*         TABLE OF FUNCTIONS WHICH REQUIRE UCPA VALIDITY CHECKING.
*
*         2 BITS PER SFCALL FUNCTION - 1/A, 1/B
*         A      IF SET, UCPA VALIDATION IS REQUIRED.
*         B      IF SET, UCPA TO BE VERIFIED IS EXTENDED ADDRESS.
*
*         NOTE - INSTALLATION RESERVED SFCALL FUNCTIONS (70-76)
*         SHOULD USE ADDITIONAL VALIDATION WORD.
 
 SSFC     BSS    0
          POS    60-ENDT     SF.ENDT
          VFD    1/1
          VFD    1/0
          POS    60-READ     SF.READ
          VFD    1/1
          VFD    1/0
          POS    60-WRIT     SF.WRIT
          VFD    1/1
          VFD    1/0
          POS    60-XRED     SF.XRED
          VFD    1/1
          VFD    1/1
          POS    60-XWRT     SF.XWRT
          VFD    1/1
          VFD    1/1
          POS    1
          VFD    1/0         AVOID *PASS* INSTRUCTIONS
          BSS    0           FORCE UPPER
 
 
 SSFE     CON    0           SFCALL REMAINING MONITOR MODE TIME
 
 SSFF     CON    0           UCP EJT ENTRY ABSOLUTE ADDRESS
 SSFG     CON    0           *STSW* FLAGS FOR FUNCTION 24
          EJECT
 SST      SPACE  4,10
***       *SST*
*         PROCESS FILE SWITCHING.
*
*T        18/ *SST*,1/ ,1/R,10/ ,12/ SS,18/ ADDR
*
*         SS     SUBSYSTEM IDENTIFICATION OF PARTNER (FCN = 1 OR 2).
*
*T ADDR   12/ FNTR,12/ FNTS,18/ RSV,6/ FCN,11/ ST,1/C
*T ADDR+1 24/ JSN,24/ 0,12/ JEJT
*
*         C      COMPLETION BIT.
*         FCN    FUNCTION CODE -
*                CUSU = 1    CALLER UCP - SCP TO UCP SWITCH.
*                CUUS = 2    CALLER UCP - UCP TO SCP SWITCH.
*                CSUS = 3    CALLER SCP - UCP TO SCP SWITCH.
*                CSSU = 4    CALLER SCP - SCP TO UCP SWITCH.
*         FNTR   FNT ORDINAL IN RECEIVER-S FNT (RETURNED PARAMETER).
*                (SET TO PARTNER CPA BY *CPUMTR* FOR *1MA*.)
*         FNTS   FNT ORDINAL IN SOURCES FNT.
*         JEJT   PARTNERS EJT ORDINAL (FCN = 3 OR 4).
*         JSN    JOB SEQUENCE NUMBER FOR PARTNER (FCN = 3 OR 4).
*         RSV    RESERVED FOR CDC.
*         ST     RETURN STATUS CODE -
*                00     SWITCH COMPLETED NORMALLY.
*                01     FILE BUSY.
*                02     PARTNER ROLLED OUT.
*                03     INCORRECT FILE TYPE.
*                04     PARTNERS IDENTIFICATION NOT KNOWN.
*                05     NO SPACE IN RECEIVER-S NFL.
*                06     LOCAL FILE LIMIT (MAXIMUM NFL).
*                07     FILE *FNTS* NOT FOUND.
 
 
*         GET FUNCTION CODE.
 
 SST      SB6    X5          CHECK *ADDR* WITHIN RANGE
          LE     B6,B1,CPE   IF *ADDR* .LE. 1
          MX2    -6
          GT     B6,B4,CPE   IF *ADDR* .GE. FL
          SX3    X5
          SA1    B3          RA
          IX6    X3+X1
          ERX1   X6          GET (ADDR)
          SA6    T1          SAVE ABSOLUTE ADDRESS OF PARAMETER BLOCK
          LX1    59-0
          NG     X1,CPE      IF COMPLETION BIT ALREADY SET
          LX1    49          VALIDATE FUNCTION CODE
          BX3    -X2*X1
          SB5    X3-FCNM
          ZR     X3,CPE      IF *FCN* INVALID
          SX7    X3-1        FUNCTION CODE - 1
          SX3    X3-CSUS
          PL     B5,CPE      IF *FCN* INVALID
          PL     X3,SST2     IF CALL FROM SCP
 
*         PROCESS REQUEST FROM UCP TYPE CALLER.
 
          LX5    -18         GET SUBSYSTEM CODE
          BX1    -X0*X5
          LX5    18
          SX2    X1-LSSI-1
          NG     X2,CPE      IF NOT SUBSYSTEM
          SA2    B7+AACW     CHECK VALIDATION OF CALLER AS UCP
          LX2    59-11
          BX4    X1          SAVE SSID
          SB3    SST1        SET EXIT ADDRESS FOR *RSC*
          NG     X2,RSC      IF VALIDATED, RETURN SUBSYSTEM CONTROL
          EQ     CPE         UNAUTHORIZED UCP
 
*         RETURN FROM *RSC* WITH -
*         (A2)   SUBSYSTEM CPA + STSW.
*         (B7)   CALLER-S CPA.
*         (X0)   -7777B.
*         (X3)   SUBSYSTEM RA.
*         (X4)   SUBSYSTEM ID.
*         (X6)   SUBSYSTEM FL.
*         (X7)   FUNCTION CODE - 1.
 
*         *RSC* ERROR EXIT ADDRESSES -
 
+         VFD    12/SST7-SST1,18/SST7,12/SST10-SST1,18/SST1
 
 SST1     SX1    SSIW        CHECK SUBSYSTEM IDENTIFICATION
          IX1    X3+X1
          ERX1   X1
          SB6    A2-STSW     SCP CPA
          BX1    X1-X4       COMPARE WITH SUBSYSTEM IDENTIFICATION
          SX2    SSCR
          IX2    X2+X3
          ERX3   X2          SUBSYSTEM RECEIVING BUFFER
          BX1    -X0*X1
          LX3    1
          NZ     X1,CPE      IF SUBSYSTEM NOT INITIALIZED
          SB4    B7          UCP CPA
          SA1    B4+JCIW     CHECK IF UCP IS SUBSYSTEM
          LX1    36
          PL     X3,SST1.1   IF NO RESTRICTIONS ON UCP ACCESS
 
*         VALIDATE PERMISSION STATUS.
 
          SA2    B4+SEPW     READ SPECIAL ENTRY POINT WORD
          BX1    -X0*X1
          LX2    59-50
          NG     X2,SST1.1   IF SSJ= ENTRY POINT
          ZR     X1,CPE      IF NOT AUTHORIZED UCP
 SST1.1   SA3    T1          GET ABSOLUTE ADDRESS OF PARAMETER BLOCK
          SX2    B1
          IX2    X2+X3
          SA1    B6+TFSW     GET SCP EJT ORDINAL
          LX1    12
          BX7    -X0*X1
          EWX7   X2
          EQ     SST3        CONTINUE PROCESSING
 
*         PROCESS REQUEST FROM SCP TYPE CALLER.
*         ENSURE THAT CALLER IS SUBSYSTEM AND
*         THAT SUBSYSTEM IDENTIFICATION WORD MATCHES CALLER.
 
 SST2     SA2    B7+JCIW     CHECK SUBSYSTEM CALL
          LX2    -24         GET SUBSYSTEM IDENTIFICATION
          BX4    -X0*X2
          SA1    RA
          SX7    SSIW        READ SUBSYSTEM IDENTIFICATION WORD
          IX1    X1+X7
          ERX1   X1
          BX7    -X0*X1      SUBSYSTEM CODE
          BX7    X4-X7
          SX2    X4-LSSI-1
          NZ     X7,CPE      IF SUBSYSTEM NOT INITIALIZED
          NG     X2,CPE      IF CALLER IS NOT A SUBSYSTEM
 
*         VALIDATE *JSN* AND *JEJT* FROM (*ADDR*+1).
 
          SB6    CPE         SET ERROR RETURN FOR *CUI*
          SB5    SST2.1      SET NORMAL RETURN FOR *CUI*
          EQ     CUI         CHECK UCP IDENTIFICATION
 
 SST2.1   BX7    X6          SAVE JOB SEQUENCE NUMBER MATCH STATUS
          SX6    RC04        * PARTNERS IDENTIFICATION NOT KNOWN.*
          SB4    X5          UCP CPA
          NZ     X7,SST6     IF JOB SEQUENCE NUMBER MISMATCH
          SX6    RC02        * PARTNER ROLLED OUT.*
          NZ     X2,SST6     IF UCP NOT AT CONTROL POINT
          SA2    CMCL        CHECK FOR STORAGE MOVE
          AX2    48
          LX2    7
          BX2    X2-X5
          ZR     X2,SXS      IF UCP MOVING, SET *X* STATUS
          SA2    X5+STSW
          SB6    X5          PARTNERS CPA
          LX2    59-24
          NG     X2,SST6     IF ROLLOUT REQUESTED ON UCP
 
*         CONTINUE PROCESSING ALL FUNCTIONS.
*
*                (X3) = ABSOLUTE ADDRESS OF STATUS WORD.
*                (X4) = SSID.
*                (B4) = UCP CPA.
*                (B6) = CPA OF PARTNER.
*                (B7) = CPA OF CALLER.
 
*         CHECK LONG TERM CONNECTION.
 
 SST3     BX2    X4          SSID
          BX5    X3          SAVE REGISTERS
          SB5    B6
          SB3    B4
          SA3    B4+SSCW
          SB4    SST3.1      RETURN ADDRESS FOR *CSC*
          EQ     CSC         CHECK SUBSYSTEM CONNECTION
 
 SST3.1   ZR     B6,CPE      IF NOT CONNECTED
          SA3    A3
          LX3    B6
          SB6    B5
          SB4    B3
          LX3    59-3
          PL     X3,CPE      IF NO LONG TERM CONNECTION
          BX3    X5
          ERX2   X3          READ (ADDR)
 
*         VALIDATE *FNTS* ADDRESS.
 
          LX2    59-12
          SB5    B6          GET PARTNER FL STATUS WORD
          NG     X2,SST4     IF FCN = 1 OR 3
          SB5    B7+          GET CALLER FL STATUS WORD
 SST4     LX2    59-35-59+12
          SA1    B5+FLSW
          BX4    -X0*X2      FNTS
          LX1    12
          SB4    X4
          BX2    -X0*X1      NFL SIZE
          LX2    6
          SB5    X2
          MX6    -RMSK
          GE     B4,B5,CPE   IF *FNTS* OUT OF RANGE
          SB5    FNTN
          LE     B4,B5,CPE   IF *FNTS* BELOW RANGE
          LX1    -24         SHIFT TO RA
          BX1    -X6*X1
          LX1    6
          IX4    X1-X4       READ *FNTS*
          SX6    RC07        * FILE NOT FOUND.*
          ERX2   X4
          ZR     X2,SST6     IF FNT EMPTY
 
*         VALIDATE *FNTS* FILE TYPE.
 
          MX6    -6
          LX2    0-6
          BX1    -X6*X2
          SB4    X1+
          SX6    RC03
          SB5    59
          SA1    SLFT        SET VALID FILE TYPES MASK
          SB4    B5-B4       SET SHIFT BIAS
          LX1    X1,B4
          PL     X1,SST6     IF FILE TYPE NOT VALID
 
*         CHECK FILE BUSY STATUS.
 
          R=     X6,RC01     * FILE BUSY.*
          IX4    X4+X6
          ERRNZ  RC01-1
          ERX1   X4
          LX1    59-0
          PL     X1,SST6     IF FILE *FNTS* BUSY
          LX1    1           SET FILE BUSY
          BX7    -X6*X1
          ERRNZ  RC01-1
          R=     X6,RC00     NORMAL RETURN
          ERX2   X3          GET FUNCTION CODE
          LX2    59-12
          NG     X2,SST5     IF FCN = 1 OR 3
          EWX7   X4          UPDATE FST
          BX7    X4          SAVE FST ADDRESS FOR *1MA* CALL REJECT
          SA7    SSTA
 SST5     ERX2   X3          GET PARAMETER WORD
          SX1    B6          PARTNER-S CP ADDRESS
          MX7    -48
          LX1    -12
          BX2    -X7*X2      CLEAR *FNTR* FIELD
          BX7    X0*X2       CLEAR STATUS FIELD
          BX7    X1+X7       INSERT CP ADDRESS (FOR *1MA*)
          BX7    X6+X7       INSERT RETURN STATUS
          ZR     X6,SST8     IF NO ERROR CODE RETURNED
          SX6    B1          SET COMPLETION BIT
          BX6    X6+X7
          EWX6   X3
          BX7    X7-X7       CLEAR RA+1
          EQ     MTRP        RETURN TO CALLER
 
*         ERROR PROCESSING.
 
 SST6     SB6    B0          NO *FNTR* (CPA) ENTRY ON ERROR
          LX6    1
          EQ     SST5        COMPLETE PROCESSING
 
 SST7     EQ     CPE         ERROR EXIT FROM *RSC*
 
*         CALL *1MA* TO PROCESS FILE SWITCH.
 
 SST8     EWX7   X3
          SB3    SST8.1      *ACB* RETURN ADDRESS
          EQ     ACB         ASSIGN COMMUNICATION BUFFER
 
 SST8.1   ZR     X1,SST9     IF NO BUFFER AVAILABLE
          BX6    X1          SET PARAMETER WORD
          SA7    X1+B1       SET (*ADDR*) IN BUFFER
          SA6    APQA
          SA5    RA1         GET (RA+1)
          ERX5   X5
          SX1    B1          GET (*ADDR*+1)
          IX3    X3+X1
          ERX1   X3
          MX0    -18
          BX0    -X0*X5      EXTRACT *ADDR*
          BX7    X1
          SA7    A7+B1       SET (*ADDR*+1) IN BUFFER
          SX5    B7+         SET CPA
          SX2    3           *1MA* FUNCTION CODE
          EQ     SSC15       CALL *1MA*
 
 SST9     ERX2   X4          RESET FILE NOT BUSY
          SX6    B1
          BX6    X2+X6
          EWX6   X4
 SST10    EQ     SXS         SET *X* STATUS
 
*         *SST* REQUEST LEGAL FILE TYPES.
 
 QFFT     DECMIC QFFT        QUEUE FILE
 PMFT     DECMIC PMFT        DIRECT ACCESS PERMANENT FILE
 LOFT     DECMIC LOFT        LOCAL FILE
 LIFT     DECMIC LIFT
 
 SLFT     CON    1S"QFFT"+1S"PMFT"+1S"LOFT"+1S"LIFT"
 SSTA     CON    0           FST ADDRESS
          TITLE  SCP SUBROUTINES.
 CSC      SPACE  4,20
**        CSC - CHECK SUBSYSTEM CONNECTION.
*
*         CSC WILL DETERMINE IF THE UCP IS CURRENTLY CONNECTED TO
*         THE SPECIFIED SUBSYSTEM AS A UCP, BASED ON WORD *SSCW*.
*
*         ENTRY  (X0) = -7777B.
*                (X2) = SSID.
*                (X3) = *SSCW* WORD TO CHECK.
*                (B4) = RETURN ADDRESS.
*
*         EXIT   (B6) = SHIFT COUNT TO SHIFT *SSCW* SO THAT THE
*                       BYTE FOR THE SPECIFIED SUBSYSTEM IS IN THE
*                       BOTTOM.  IF THE UCP IS NOT CONNECTED TO THE
*                       SPECIFIED SUBSYSTEM, THE SHIFT COUNT IS
*                       FOR AN EMPTY BYTE, IF THERE IS ONE.
*                (B6) = 0, IF THE UCP IS CURRENTLY CONNECTED TO 5
*                       SCP-S, NONE OF WHICH IS THE SPECIFIED ONE.
*
*         USES   X - 1, 2, 3, 6.
*                B - 6.
 
 
 CSC      BSS    0           ENTRY
          SB6    60          INITIALIZE SHIFT COUNT
          SX6    B0+
          SX2    X2-LSSI     SUBSYSTEM INDEX
 CSC1     BX1    -X0*X3
          LX3    -12
          ZR     X1,CSC3     IF NO CONNECTION IN THIS BYTE
          AX1    6
          IX1    X1-X2
          ZR     X1,/MONITOR/RB4  IF SPECIFIED SUBSYSTEM
 CSC2     SB6    B6-12
          NZ     B6,CSC1     IF MORE TO CHECK
          SB6    X6
          JP     B4          RETURN
 
 CSC3     NZ     X6,CSC2     IF EMPTY BYTE ALREADY FOUND
          SX6    B6+
          EQ     CSC2        CONTINUE
 CUI      SPACE  4,25
**        CUI - CHECK UCP IDENTIFICATION.
*
*         ENTRY  (B5) = RETURN ADDRESS IF NO ERROR.
*                (B6) = RETURN ADDRESS IF INVALID EJT ORDINAL.
*                (X0) = -7777B.
*                (T1) = ABSOLUTE ADDRESS OF PARAMETER BLOCK.
*
*         EXIT   (A1) = ABSOLUTE ADDRESS OF UCP EJT ENTRY.
*                (X0) = -7777B.
*                (X1) = *JSNE* WORD OF UCP EJT ENTRY.
*                (X2) = UCP JOB STATUS - EXJS (IF A *DMP=* PROGRAM IS
*                       EXECUTING AND THE *DMP=* FLAG IS NOT SET IN THE
*                       REQUEST, THE UCP JOB STATUS WILL BE FLAGGED AS
*                       MXJS TO INDICATE JOB ROLLED OUT).
*                (X3) = ABSOLUTE ADDRESS OF PARAMETER BLOCK.
*                (X5) = UCP CONTROL POINT ADDRESS IF (X2) = 0.
*                (X6) .NE. 0 IF SPECIFIED JSN DOES NOT MATCH JSN IN
*                       SPECIFIED EJT ORDINAL OR IF THE *DMP=* FLAG IS
*                       SET AND A *DMP=* PROGRAM IS NOT EXECUTING.
*
*         USES   A - 1, 2, 3.
*                B - 6.
*                X - 0, 1, 2, 3, 5, 6.
 
 
 CUI      BSS    0           ENTRY
          SA3    T1          GET UCP IDENTIFICATION
          SX1    B1
          IX1    X3+X1
          ERX2   X1
          BX1    -X0*X2      UCP EJT ORDINAL
          TX6    X1,-EJTM
          ZR     X1,RB6      IF NO EJT ORDINAL
          PL     X6,RB6      IF EJT ORDINAL EXCEEDS MAXIMUM
          CX6    X1,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA1    X6+JSNE,EJT GET UCP EJT ENTRY
          MX6    24
          BX0    X2
          BX2    X6*X2       JOB SEQUENCE NUMBER FROM CALL
          SB6    B5          SET NORMAL RETURN ADDRESS
          BX5    X6*X1       JOB SEQUENCE NUMBER FROM EJT ENTRY
          ZR     X5,CUI1     IF EJT ENTRY NOT IN USE
          BX6    X2-X5
          SA2    A1+SCHE-JSNE
          NZ     X6,CUI1     IF JOB SEQUENCE NUMBER DOES NOT MATCH
          LX0    59-12
          LX2    59-32
          BX0    X0-X2
          MX6    -6
          PL     X0,CUI0.1   IF NO *DMP=* CONFLICT
          PL     X2,CUI1     IF *DMP=* REQUEST ON NON-*DMP=* PROGRAM
          SX2    MXJS        INDICATE *DMP=* ROLLOUT STATUS
          EQ     CUI0.2      SET EXIT CONDITIONS
 
 CUI0.1   LX2    0-12-59+32
          BX0    -X6*X1
          BX5    -X6*X2      CP NUMBER IF *EXJS* STATUS
          AX2    X0,B1       JOB STATUS
 CUI0.2   LX5    7           CP ADDRESS IF *EXJS* STATUS
          SX2    X2-EXJS
          SX6    B0          SET NO ERROR
 CUI1     MX0    -12
          JP     B6          RETURN
 CWT      SPACE  4,10
**        CWT - CALCULATE WORD TRANSFER SIZE (CM OR ECS).
*
*         THE ENTIRE BLOCK WILL BE TRANSFERRED IF .LE. *MAXB* WORDS
*         ARE REQUESTED, IF THE REMAINING *SFCALL* MONITOR MODE TIME
*         IS SUFFICIENT, OR IF THE REQUESTED DATA TRANSFER SIZE IS
*         WITHIN 40B WORDS OF THE AMOUNT THAT CAN BE TRANSFERRED IN
*         THE REMAINING TIME.  OTHERWISE, THE DATA TRANSFER SIZE WILL
*         BE SET TO THE MAXIMUM OF *MAXB* AND THE REMAINING TIME
*         TRANSFER SIZE (IN MULTIPLE OF 10B).
*
*         ENTRY  (X7) = WORD COUNT.
*                (B6) = EXIT ADDRESS IF CM TRANSFER.
*                     = COMPLEMENT OF EXIT ADDRESS IF ECS TRANSFER.
*                (B4) = SCP FL.
*                (SSFE) = SFCALL REMAINING MONITOR MODE TIME.
*
*         EXIT   (X3) = SCP FL.
*                (B4) = WORD TRANSFER SIZE.
*                (SSFE) = MONITOR MODE TIME REMAINING AFTER TRANSFER.
*
*         USES   X - 1, 2, 3, 7.
*                A - 1, 7.
*                B - 4, 6.
 
 
 CWT      SX3    B4+         SAVE SCP FL
          SA1    SSFE        GET REMAINING MONITOR MODE TIME
          TB4    SFCS        SET CM TRANSFER RATE SHIFT
          PL     B6,CWT1     IF CM TRANSFER
          TB4    SFES        SET ECS TRANSFER RATE SHIFT
          SB6    -B6         SET RETURN ADDRESS
 CWT1     SX2    X7-MAXB-1
          NG     X2,CWT2     IF .LE. *MAXB* WORDS TO BE TRANSFERRED
          AX1    B4          TRANSFER SIZE FOR REMAINING TIME
          AX1    3           ROUND DOWN TO MULTIPLE OF 10B
          LX1    3
          IX2    X7-X1
          NG     X2,CWT2     IF TIME TO COMPLETE TRANSFER
          AX2    5
          ZR     X2,CWT2     IF WITHIN 40B WORDS OF COMPLETION
          SX7    MAXB        TRANSFER AT LEAST *MAXB* WORDS
          IX2    X1-X7
          NG     X2,CWT2     IF TRANSFER MINIMUM WORDS
          LX7    X1
 CWT2     BX2    X7          CALCULATE TRANSFER TIME
          SA1    A1
          LX2    B4
          SB4    X7          SET TRANSFER SIZE
          IX7    X1-X2       DECREMENT REMAINING MONITOR MODE TIME
          SA7    A1
          JP     B6          RETURN
 SCB      SPACE  4,10
**        SCB - SET COMPLETION BIT SPECIFIED BY *ADDRESS*.
*
*         SCB SETS THE COMPLETION BIT FOR AN SF.XXXX FUNCTION OR
*         AN SF.XXXX FUNCTION WITHIN A LIST.
*
*         ENTRY  (A2) = SUBSYSTEM *STSW* WORD.
*                (A5) = PPU OR ADDRESS.
*                (X3) = SUBSYSTEM RA.
*                (X5) = PPU OUTPUT REGISTER.
*                (B3) = SUBSYSTEM FL.
*                (B5) = RELATIVE ADDRESS OF COMPLETION BIT WORD.
*
*         EXIT   TO *PPRX* OR *PPR1* TO COMPLETE PP REQUEST.
 
 
 SCB      GE     B5,B3,SCB3  IF WORD TO SET COMPLETE OUTSIDE SCP FL
          AX5    18
          SX4    B1
          MX0    -6
          SX1    B5
          IX7    X3+X1
          ERX1   X7          SET COMPLETION BIT
          SA7    T1          SAVE ABSOLUTE ADDRESS
          BX5    -X0*X5      REPLY CODE
          BX7    X4+X1
          SX6    X1-LIST     CHECK LIST PROCESSING IN EFFECT
          MX2    -54
          BX0    -X0*X6
          LX5    -6
          BX1    -X2*X7
          LX7    -6
          BX6    X5+X1
          ZR     X0,SCB0     IF LIST PROCESSING IN EFFECT
          SX0    X0-XLST+LIST
          NZ     X0,SCB2     IF NOT EXTENDED LIST PROCESSING
          SX0    B1+
 SCB0     ZR     X5,SCB1     IF NO ERROR ENCOUNTERED
          SX6    RC40        * AT LEAST ONE ERROR ENCOUNTERED IN LIST.*
          LX6    54
          BX1    X1+X6
 SCB1     SB6    X7
          BX5    X4+X5       REPLY CODE AND COMPLETION BIT FOR SF.XXXX
          GE     B6,B3,SCB3  IF WORD TO SET COMPLETE OUTSIDE SCP FL
          SX6    B6
          IX6    X6+X3
          ERX3   X6          FUNCTION PARAMETER WORD
          SA6    T2          SAVE ABSOLUTE ADDRESS
          IX0    X0+X4       LIST ADDRESS INCREMENT
          LX0    6
          BX2    -X2*X3
          IX6    X0+X1       POINT TO NEXT FUNCTION IN LIST
          BX7    X2+X5       SET COMPLETION BIT AND REPLY CODE
          LX4    42
          SA3    T2
          EWX7   X3
          IX6    X6-X4       DECREMENT NUMBER OF FUNCTIONS IN LIST
 SCB2     BX7    X7-X7       CLEAR OUTPUT REGISTER, NO ERRORS
          SA3    T1
          EWX6   X3
          EQ     PPR1        EXIT TO STORE OUTPUT REGISTER
 
*         EXIT FOR INVALID SCP PARAMETERS.  (ALSO ENTERED HERE
*         FROM *SSR*.)
 
 SCB3     SA2    A2-STSW+TFSW  GET SCP EJT ORDINAL
          MX0    -12
          LX2    12
          BX2    -X0*X2
          CX1    X2,EJT      CONVERT EJT ORDINAL TO OFFSET
          TA1    X1+JSNE,EJT GET SCP JOB SEQUENCE NUMBER
          SX7    X2+5*10000B STATUS = SCP INVALID PARAMETERS
          MX0    24
          BX1    X0*X1
          BX7    X7+X1
          LX7    24
          SA7    A5          STORE PP OUTPUT REGISTER
          EQ     PPRX        EXIT
 SSR      SPACE  4,10
**        SSR - SET SPECIAL RECEIVING BUFFER.
*
*         SSR SETS UP A DATA TRANSFER TO THE SCP RECEIVING BUFFER
*         POINTED TO BY *SSCR* WITHIN THE SUBYSTEM FL.
*
*         ENTRY  (A2) = SUBSYSTEM *STSW* WORD.
*                (A5) = PPU OR ADDRESS.
*                (X0) = -7777B.
*                (X5) = PPU OUTPUT REGISTER.
*                (X3) = SUBSYSTEM RA.
*                (X7) = NOT READY FOR DATA STATUS (2).
*                (B3) = SUBSYSTEM FL.
*
*         EXIT   (X7) = NEW PP OUTPUT REGISTER.
*                TO *HNG* IF WORD COUNT EXCEEDS MESSAGE BUFFER LENGTH.
*                TO *PPR1* IF NOT READY FOR DATA.
*                TO *SCB3* IF BUFFER ADDRESS OUTSIDE SCP FL.
*                TO *TDA2.3* IF TRANSFER COMPLETE.
*                TO *TDA3* IF IDENTIFICATION WORD NOT INITIALIZED.
 
 
 SSR      SX1    SSIW        CHECK SUBSYSTEM IDENTIFICATION WORD
          SX2    X1+B1       SUBSYSTEM RECEIVING BUFFER POINTER WORD
          ERRNZ  SSIW+1-SSCR CODE DEPENDS ON VALUE
          IX1    X1+X3
          MX4    6           EXTRACT WORD COUNT
          ERX1   X1
          LX5    -24         COMPARE SUBSYSTEM IDENTIFICATIONS
          BX4    X4*X5
          BX5    X1-X5
          LX4    6
          IX1    X2+X3
          ERX1   X1
          SB5    X4
          BX2    -X0*X5
          LX5    X1
          SX1    B1
          SX4    X4-7        VALIDATE THE WORD COUNT
          NZ     X2,TDA3     IF IDENTIFICATION WORD NOT INITIALIZED
          PL     X4,HNG      IF WC .GT. MESSAGE BUFFER
          SA4    A5+B1
          LX4    59-20
          PL     X4,SSR1     IF NOT SUBSYSTEM ABORTED *TDAM* CALL
          SA4    RC          CHECK RCLP REQUEST
          IX1    X3+X1
          ERX1   X1          RA+1 OF SCP RECEIVING NOTIFICATION
          BX6    X4-X1
          AX6    18          COMPARE SUBSYSTEM IDENTIFIERS
          SA4    A5+2
          BX6    X6-X4
          SX1    X1          ADDRESS OF RECALL WORD
          NZ     X6,SSR1     IF RECEIVER NOT IN RECALL ON ABORTED SCP
          IX4    X3+X1       ABSOLUTE ADDRESS OF RECALL WORD
          ERX1   X4
          SX6    ES1+1       SUBSYSTEM NOT PRESENT STATUS
          BX6    X1+X6
          EWX6   X4
          TIC    DCPC        INVALIDATE CACHE ON OTHER CPU, IF PRESENT
 SSR1     NG     X5,PPR1     IF NOT READY FOR DATA
          SB6    X5
          MX6    1
          ZR     B6,PPR1     IF NOT READY FOR DATA
          LE     B6,B1,SCB3  IF BUFFER ADDRESS INVALID
          SX0    X5+
          SB6    X5+B5       CHECK ADDRESS OUT OF RANGE
          IX0    X0+X3       ABSOLUTE ADDRESS OF RECEIVING BUFFER
          GT     B6,B3,SCB3  IF BUFFER ADDRESS OUTSIDE SCP FL
          SA4    A5+B1       MOVE 2 WORDS OF DATA TO RECEIVING BUFFER
          BX6    X6+X5       SET CPU INTERLOCK BIT
          LX7    X4
          SA4    A4+B1
          EWX7   X0
          BX7    X4
          SX1    B1
          IX0    X1+X0
          SB5    B5-2
          EWX7   X0
          LE     B5,B0,SSR3  IF ALL WORDS MOVED
 SSR2     SA4    A4+B1       MOVE REMAINING WORDS
          IX0    X0+X1
          SB5    B5-1
          BX7    X4
          EWX7   X0
          GT     B5,B0,SSR2  IF MORE WORDS TO MOVE
 SSR3     BX7    X7-X7
          SX1    SSCR
          IX1    X1+X3
          TIC    DCPC        INVALIDATE CACHE ON OTHER CPU, IF PRESENT
          EWX6   X1          SUBSYSTEM RECEIVING BUFFER POINTER WORD
          EQ     TDA2.3      RESTART SCP CPU
 
          ENDBLK
          BLOCK  SCPUEC,(SCP FACILITY ECS INTERFACE.)
 SFE      SPACE 4,10
**        SFE - SFCALL SF.READ/SF.WRIT ECS TRANSFER.
*
*         SF.READ - TRANSFER DATA FROM UCP CM TO SCP ECS (WRITE ECS)
*         OR TRANSFER DATA FROM UCP ECS TO SCP CM (READ ECS).
*
*         SF.WRIT - TRANSFER DATA FROM SCP CM TO UCP ECS (WRITE ECS)
*         OR TRANSFER DATA FROM SCP ECS TO UCP CM (READ ECS).
*
*         ENTRY  (A0) = CPU NUMBER (0 OR 1).
*                (X0) = -7777B.
*                (X2) = EXTENDED ADDRESS WORD.
*                (X4) = LIST PROCESSING FLAG.
*                (X5) = 0, IF SF.WRIT OR SF.XWRT, .LT. 0 IF SF.READ
*                       OR SF.XRED.
*                (X6) = UCP/SCP ABSOLUTE CM ADDRESS.
*                (X7) = WORD COUNT.
*                ((B3)) = SCP RA.
*                (B4) = SCP FL.
*                (B7) = SCP CPA.
*
*         EXIT   TO */MONITOR/S404* IF ECS TRANSFER COMPLETE.
*                (A0) = CPU NUMBER.
*                (X2) = LIST PROCESSING FLAG.
*                (X3) = SCP FL.
*                (X5) = TRANSFER SIZE.
*
*                TO */MONITOR/CPE* IF NOT IN CPU 0 FOR ECS TRANSFER.
*                (A0) UNCHANGED.
*
*                TO */MONITOR/SSF11* IF UCP ECS ADDRESS ILLEGAL.
*                (A0), (B4) UNCHANGED.
*
*                TO */MONITOR/SSF20* IF SCP ECS ADDRESS ILLEGAL.
*                (A0), (B4) UNCHANGED.
*
*                TO */MONITOR/SSF12* IF ECS ABORT OR PARITY ERROR.
*                (A0), (X0), (B4) RESTORED.
*                (X5) = REPLY CODE.
*                (B6) .GT. 0 TO INDICATE NOT FATAL OR FORCED ERROR.
*
*         USES   A - 0, 1.
*                B - 4, 5, 6.
*                X - ALL.
*
*         CALLS  /MONITOR/CWT.
*
*         MACROS PER, RUE, WUE.
 
 
*         PROCESS UCP ECS TO/FROM SCP CM TRANSFER.
 
 SFE      LX4    -18         GET UCP CONTROL POINT ADDRESS
          SA1    X4+ECSW     GET UCP ECS RA AND FL
          LX4    18
          LX2    -24
          SB5    /MONITOR/SSF11-/MONITOR/SSF20  SET ADDRESS ERROR EXIT
          EQ     SFE2        VALIDATE UCP ECS ADDRESS
 
*         PROCESS UCP CM TO/FROM SCP ECS TRANSFER.
 
 SFE1     SB5    B0          SET ADDRESS ERROR EXIT BIAS
          SA1    B7+ECSW     GET SCP ECS RA AND FL
          BX5    -X5         SET WE FOR SF.READ, RE FOR SF.WRIT
 
*         VALIDATE SCP OR UCP ECS ADDRESS.
 
 SFE2     BX3    -X0*X1      SCP OR UCP ECS FL/*UEBS*
          LX1    -12
          BX1    -X0*X1      SCP OR UCP ECS RA/*UEBS*
          TLX3   9,UESC
          MX0    -24
          TLX1   9,UESC
          BX2    -X0*X2      SCP OR UCP RELATIVE ECS ADDRESS
          IX3    X3-X2       CHECK BLOCK LWA .GT. ECS FL
          IX0    X2+X1       SCP OR UCP ABSOLUTE ECS ADDRESS
          SB6    SFE3        SET RETURN ADDRESS FOR *CWT*
          IX3    X3-X7
          SB6    -B6         INDICATE ECS TRANSFER
          PL     X3,/MONITOR/CWT  IF ECS ADDRESS LEGAL
          JP     B5+/MONITOR/SSF20  EXIT TO SET ERROR CODE
 
 SFE3     SB5    A0          SAVE CPU NUMBER
          SA0    X6          SET SCP OR UCP CM ADDRESS
          TNZB5  /MONITOR/CPE,NOTDCE  IF NOT CPU 0
          MX2    -24
          BX0    -X2*X0
          SB6    SFE5        SET RETURN ADDRESS
          BX6    -X2*X6
          LX6    30
          BX0    X6+X0
          BX2    X4          SAVE LIST PROCESSING FLAG
          PL     X5,SFE4     IF WRITE ECS
          RUE    MONITOR     READ (B4) WORDS FROM USER ECS
          PER    /SCPUEC/SFE6,/ECS/PER  IF PARITY ERROR
          EQ     SFE5        RESTORE REGISTERS AND EXIT
 
 SFE4     WUE    MONITOR     WRITE (B4) WORDS TO USER ECS
          PER    /SCPUEC/SFE6,/ECS/PER  IF PARITY ERROR
 SFE5     SA0    B5          RESET CPU NUMBER
          SX5    B4          SET TRANSFER LENGTH
          EQ     /MONITOR/S404  EXIT
 
 SFE6     SX5    RC56        * ECS ABORT/PARITY ERROR.*
          SA0    B5          RESET CPU NUMBER
          MX0    -12
          SB4    X3          RESTORE SCP FL
          SB6    B1          INDICATE NO ERROR
          EQ     /MONITOR/SSF12  SET COMPLETE BIT AND ERROR CODE
 
          ENDBLK
          BLOCK  SUBCP,(SUB-CONTROL POINT PROCESSING.),MONITOR
 BCE      SPACE  4,15
**        BCE - BEGIN CONTROL POINT EXECUTIVE.
*
*         ENTRY  (B7) = CONTROL POINT ADDRESS.
*
*         EXIT   TO *ESC0*.
*
*         USES   X - 0, 2, 4.
*                A - 2.
*                B - 3.
*
*         CALLS  CPT.
 
 
 BCE      SB3    BCE1        *CPT* RETURN ADDRESS
          TJP    (/NVE/CPT,NVE,/CME/CPT,CME,/MONITOR/CP76,CP176,/MONITOR
,/CPT)
 
 BCE1     SA2    B7+STSW
          MX4    1
          SX0    B1          SET CP EXEC AS NEXT JOB
          LX4    56-59       SUB-CP BIT
          EQ     ESC0        END SUB-CONTROL POINT
 ESC      SPACE  4,25
**        ESC - END SUB-CONTROL POINT.
*
*         CLEAR SUB-CONTROL POINT ACTIVE STATUS, RELATIVIZE SUB-CONTROL
*         POINT EXCHANGE PACKAGE, AND RETURN CONTROL TO NEW JOB OR
*         CONTROL POINT EXECUTIVE.
*
*         IF ENTERED AT *ESC*, THE CPU WILL BE SWITCHED TO A NEW JOB
*         ON EXIT TO *BNJ*.  IF ENTERED AT *ESC0*, CONTROL WILL BE
*         RETURNED TO THE CONTROL POINT EXECUTIVE.
*
*         ENTRY  (X2) = STSW OF CONTROL POINT.
*                (X4) = SUB CONTROL POINT ACTIVE BIT.
*                (A2) = ADDRESS OF STSW IN CONTROL POINT AREA.
*                (X1 BITS 0-17) = CONTROL POINT ADDRESS IF ENTERED AT
*                                 *ESC*.
*
*         EXIT   TO *BNJ3* TO START NEW JOB IF ENTERED AT *ESC*.
*                (CPAL+A0) SET WITH USER EXCHANGE PACKAGE ADDRESS IF
*                  ENTERED AT *ESC*.
*                TO *BNJ20* TO RESTART CONTROL POINT EXECUTIVE IF
*                  ENTERED AT *ESC0*.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 2, 3, 4, 6, 7.
*                B - 2, 3, 6, 7.
 
 
 ESC      SB3    B0+         SET NEW JOB AS NEXT ONE
          SB7    X1+         SET CONTROL POINT ADDRESS
 
*         ENTRY FROM *BCE*.
 
 ESC0     BX7    -X4*X2      CLEAR SUBCP ACTIVE BIT
          SA7    A2
 
*         RELATIVIZE SUB-CONTROL POINT P, RA, AND RAX.
 
          SA3    B7+4        READ RAX(CP)
          SA4    B2+4        READ RAX(S)
          MX2    24
          BX3    X2*X3
          IX7    X4-X3
          SA3    B7+B1       READ RA(CP)
          SA7    A4+
          SA4    B2+1        READ RA(S)
          BX1    X2*X3
          IX7    X4-X1
          SA7    A4+
          SA3    RTCL        CHECK FOR TIME LIMIT
          SA4    ACPL+A0
          BX3    -X2*X3
          BX4    -X2*X4
          AX1    36
          IX4    X3-X4
          SA3    A2-2        READ X6
          SX5    B1          READ RA+1
          IX5    X5+X1
          ERX2   X5
          MX6    -18
          BX7    -X6*X2
          IX1    X7+X1       ADDRESS OF USER EXCHANGE PACKAGE
          UX3,B6 X3          CHECK ERROR FLAG
          NZ     B3,ESC1     IF TO RETURN TO CP EXECUTIVE
          NZ     B6,ESC1     IF ERROR FLAG
          NG     X4,ESC2     IF NOT TIME LIMIT
          SB6    TLET
 
*         TERMINATE SUB-CONTROL POINT ACTIVITY.
 
 ESC1     SA4    A3-16B+12B  READ START TIME
          PX7    X3,B6
          BX6    X4
          SA4    B7+CPTW
          IX6    X4-X6       COMPUTE TIME USED
          SA6    A3+B1
          SA7    A3+
          BX7    X7-X7       CLEAR RA+1
          EWX7   X5
          ZR     B3,ESC3     IF NOT TO RETURN TO CP EXECUTIVE
 
*         EXIT TO CONTROL POINT EXECUTIVE.
 
          SA2    B7+1        GET CONTROL POINT RA
          SX3    B7
          SX7    B7          SET EXCHANGE PACKAGE ADDRESS
          LX3    24
          BX7    X3+X7       SET CONTROL POINT ADDRESS
          MX6    24
          SA7    CPAL+A0     UPDATE *CPAL*
          SX3    B2          SET EXCHANGE ADDRESS
          BX6    X6*X2       SET CONTROL POINT RA
          IX1    X3-X1       SET EXCHANGE PACKAGE MOVE DIFFERENTIAL
          SA6    ACPL+A0     UPDATE *ACPL*
          SB2    B7          SET CP EXECUTIVE EXCHANGE ADDRESS
          EQ     /MONITOR/BNJ20  COPY EXCHANGE PACKAGE
 
*         SET REMAINING TIME IN RA+1.
 
 ESC2     LX4    18          SET REMAINING TIME REQUESTED IN XJP CALL
          LX6    18
          BX6    X6*X2       CLEAR OLD TIME
          BX6    -X4+X6      SET NEW TIME
          EWX6   X5
 
*         EXIT TO BEGIN NEW JOB.
 
 ESC3     SA3    CPAL+A0     SET *CPAL* FOR EXCHANGE PACKAGE COPY
          MX6    36
          BX7    X6*X3
          BX7    X7+X1       INSERT USER EXCHANGE PACKAGE ADDRESS
          SA7    A3
          EQ     /MONITOR/BNJ3  SELECT NEXT JOB
          TITLE  CPU REQUEST PROCESSORS.
 SSE      SPACE  4,10
**        SSE - SET SUBCONTROL POINT ERROR.
*
*         ENTRY  (X7) = ERROR FLAG.
*                (B7) = CP ADDRESS.
*
*         EXIT   TO *SEF1* IF NOT ALLOWABLE SUBCP ERROR.
*                TO *BCE* IF SUBCP ERROR ALLOWED.
*
*         USES   X - 1, 2, 6.
*                B - 3.
*                A - 2, 6.
 
 
 SSE      SA2    SSEA
          SB3    X7
          LX1    X2,B3
          PL     X1,SEF1     IF ERROR NOT ALLOWED
          SA2    B7+16B      SET ERROR IN X6 OF XP
          PX6    X2,B3
          SA6    A2
          EQ     BCE         BEGIN CONTROL POINT EXECUTIVE
 
 SSEA     BSS    0           ALLOWABLE SUBCP ERROR FLAGS
          POS    60-ARET
          VFD    1/1
          POS    60-PSET
          VFD    1/1
          POS    60-TLET
          VFD    1/1
          BSS    0
 XJP      SPACE  4,25
***       *XJP*.
*         INITIATE SUB-CONTROL POINT.
*
*T        18/  *XJP*,6/ ,18/  TIML,18/  ADDR
*         TIML   CPU TIME LIMIT FOR SUB-CONTROL POINT IN MILLISECONDS.
*         ADDR   ADDRESS OF SUB-CONTROL POINT EXCHANGE PACKAGE.
*
*         RESPONSE AFTER CONTROL RETURNED TO CALLER.
*T, X2    60/  CPTW BEFORE SUBCP INITIATION.
*T, X6    12/  200B+EF,48/  RA OF SUBCP.
*T, X7    60/  CPU TIME USED BY SUBCP.
*                THIS TIME HAS THE ACCOUNTING MULTIPLIERS APPLIED
*                AND IS IN QUARTER NANO SECONDS.
*         EF     ERROR FLAG CAUSED BY SUB-CONTROL POINT.
*
*         IF AN ERROR IS ENCOUNTERED DURING PROCESSING OF THE
*         *XJP* REQUEST, CERTAIN VALUES MAY HAVE ALREADY BEEN
*         ALTERED BY CPUMTR. THESE INCLUDE:
*                RA, EM, AND RAX IN THE SUB-CP EXCHANGE PACKAGE.
*                X2, AND X6 OF THE REQUESTING PROGRAM.
 
 
 XJP      SB5    X5          ADDR
          MX0    24
          SB6    X5+20B
          LE     B5,B1,CPE   IF ILLEGAL ADDRESS
          GE     B6,B4,CPE   IF ILLEGAL ADDRESS
          NG     B6,CPE      IF ILLEGAL ADDRESS
          SA4    A0+TXJP     READ EXCHANGE PACKAGE ADDRESS AND (MA)
 
*         MOVE EXCHANGE PACKAGE TO SUB CONTROL POINT EXCHANGE AREA.
 
          SA5    B3          RA
          SX6    B5          EXCHANGE ADDRESS
          IX5    X5+X6       ABSOLUTE ADDRESS OF SUBCP XP
          ERX3   X5          READ P
          LX2    36          POSITION RA
          BX6    X3
          SX3    B1
          IX5    X5+X3       RA ADDRESS
          ERX3   X5          READ RA
          SA6    X4
          IX7    X2+X3       RA(S) + RA(CP)
          BX3    X0*X3
          LX3    24
          PX6    X3
          SA7    X4+B1
          IX1    X1-X3       FL(CP) - RA(S)
          SX3    B1
          IX5    X5+X3       FL ADDRESS
          ERX3   X5          FL(S)
          SA6    B2+16B      SET EXIT CONDITION IN (X6)
          BX2    X0*X3
          BX7    X3
          LX2    24
          SA7    A7+B1
          IX1    X1-X2       FL(CP) - RA(S) - FL(S)
          SX3    B1
          IX5    X5+X3
          ERX3   X5          EM
          SX7    B1          CLEAR COPY FLAG
          LX7    56-0
          TSX2   UEM         SET COPY FLAG IF REQUIRED
          BX3    -X7*X3
          LX2    56-0
          BX7    X2+X3
          SA2    B2+4        READ RAX(CP)
          SX3    B1
          IX5    X5+X3
          ERX3   X5          RAX(S)
          NG     X1,CPE      IF RA(S) + FL(S) .GT. FL(CP)
          SA1    A2+B1       FLX(CP)
          BX2    X0*X2
          BX1    X0*X1
          IX6    X2+X3       RAX(S) + RAX(CP)
          BX3    X0*X3
          SA7    A7+B1
          IX1    X1-X3       FLX(CP) - RAX(S)
          SX3    B1
          IX5    X5+X3
          ERX3   X5          FLX(S)
          SA6    A7+B1
          BX7    X3
          BX3    X0*X3
          LX4    36
          IX1    X1-X3       FLX(CP) - RAX(S) - FLX(S)
          SX3    B1
          IX5    X5+X3
          ERX3   X5          MA
          LX1    24
          NG     X1,CPE      IF RAX(S) + FLX(S) .GT. FLX(CP)
          BX3    -X0*X3
          SA7    A6+B1
          BX7    X4+X3
          MX6    -11B        SET LENGTH OF MOVE
          SA7    A7+B1
          SX3    B1
          IX5    X5+X3
          ERX3   X5
          BX3    -X0*X3
          BX3    X4+X3
 
*         MOVE REMAINDER OF EXCHANGE PACKAGE.
 
 XJP1     BX7    X3
          AX6    1
          SA7    A7+B1
          SX3    B1
          IX5    X5+X3
          ERX3   X5
          NZ     X6,XJP1     IF NOT END OF MOVE
          SA3    B7+STSW     SET SUBCP ACTIVE BIT
          SX7    B1
          LX7    56
          BX7    X7+X3
          SA7    A3
          SB3    XJP2        *CPT* RETURN ADDRESS
          TJP    (/NVE/CPT,NVE,/CME/CPT,CME,/MONITOR/CP76,CP176,/MONITOR
,/CPT)
 
 XJP2     SA2    RA1         CHECK FOR INITIAL CALL
          SX1    B1
          ERX5   X2
          LX1    41
          BX7    X1+X5
          BX1    X1*X5
          EWX7   X2          SET NON-INITIAL CALL FLAG
          NZ     X1,XJP3     IF NOT INITIAL CALL
          SA6    B2+12B      SET (X2) TO START TIME
 XJP3     SA2    A0+TXJP
          SA1    RTCL
          SX7    B7          CONTROL POINT ADDRESS
          LX5    -18
          MX0    -36
          LX7    24
          MX6    -18
          SA4    X2+B1       RA(S)
          BX7    X7+X2       SET CP AND EXCHANGE PACKAGE ADDRESSES
          BX1    -X0*X1      MILLISECOND CLOCK
          BX5    -X6*X5      REQUESTED TIME LIMIT
          SA7    CPAL+A0     UPDATE *CPAL*
          IX5    X5+X1
          BX4    X0*X4       SUBCP RA
          SX3    B2          SET OLD EXCHANGE ADDRESS
          BX6    X5+X4
          SX1    B2-B7       SET EXCHANGE PACKAGE MOVE DIFFERENTIAL
          SA6    ACPL+A0     UPDATE *ACPL*
          SB2    X2+         SET SUBCP EXCHANGE ADDRESS
          EQ     /MONITOR/BNJ20  CHECK EXCHANGE PACKAGE COPY
 TXJP     SPACE  4,10
**        TXJP - TABLE OF SUB-CONTROL POINT EXCHANGE PACKAGES.
*
*         INDEXED BY CPU NUMBER.
 
 
 TXJP     VFD    42/0,18/SCX
          VFD    42/0,18//DCP/SCX1
          SPACE  4
**        SCX - SUB-CONTROL POINT EXCHANGE PACKAGE.
 
 
 SCX      EXP
 
          ENDBLK
          BLOCK  CSE,(CLEAR CM STORAGE VIA ECS.),PROGRAM
 CSE      SPACE  4,10
**        CSE - CLEAR CM STORAGE VIA ECS.  (PROGRAM MODE)
*
*         ENTRY  (A5) = PPU OUTPUT REGISTER ADDRESS.
*                (X1) = BITS 0 - 47 OF OUTPUT REGISTER.
*                (X5) = PPU OUTPUT REGISTER.
*
*         USES   X - 0, 1, 2, 3, 5.
*                A - 0, 1, 2, 3.
*                B - 3, 4, 5.
 
 
 CSE      TA2    EEN         GET ECS EST ENTRY
          LX2    59-49
          TNG    X2,(/PROGRAM/CSC,CMU,/PROGRAM/CSP)  IF EM OFF OR DOWN
 
*         ENTRY FOR CME MAINFRAMES.
*         THE UEM FAKE READ IS USED ON ALL CYBER 170-8X5
*         MAINFRAMES WHEN NO EXTERNAL ECS DEVICE IS DEFINED.
*         NOTE THAT EVEN WHEN EXTERNAL ECS IS DEFINED ON A
*         CYBER 170-865/875, THE SMU DOES NOT ACCESS THE DEVICE
*         IF A FAKE READ IS ISSUED, SO NO CHECK IS NEEDED FOR EM
*         DEVICE LOGICALLY TURNED OFF.
 
 CSE1     LX5    59-43
          TNG    X5,(/PROGRAM/CEC,UEC,/PROGRAM/HNG)  IF CLEAR USER ECS
          LX5    -24-59+43
          SB3    X5          (B3) = 0 IF LIST PRESENT
          NZ     B3,CSE2     IF NOT LIST OPTION
          SA1    A5+B1       GET LIST ENTRY
 CSE2     SA0    X1
          MX5    -21
          TSX0   (LCCB-1,CP176,1-1)
          SAC    18,CCMB     ADD CLEAR CENTRAL MEMORY BUFFER
          NZ     X0,CSE3     IF NOT A 990
          SA3    ECRL        GET RAE FOR ZERO UEM BLOCK
          LX3    0-12
          MX0    -24
          BX0    -X0*X3
          TLX0   9-21+60,UESC
 CSE3     BX5    -X5*X1      GET CM ADDRESS
          AX1    24
          SB5    X1
          TLX0   (0,CP176,21)
          TLX0   (3,ESM170,0)
          TLX0   (4,UEM180,0)
          LX5    30
          BX0    X0+X5       COMBINE CM AND EM ADDRESSES
          SB4    MECB        SET WORD CLEAR COUNT
          SX5    B4
          LX5    30
 CSE4     GE     B5,B4,CSE5  IF MORE THAN 400B WORDS LEFT
          SB4    B5+         PICK UP REMAINDER
 CSE5     RE     B4          CLEAR MEMORY FROM EM
          SB0    B0+         HALF EXIT FOR FAKE READ
          SB5    B5-B4       DECREMENT WORD COUNT
          SA0    A0+B4       INCREMENT ADDRESS
          IX0    X0+X5
          GT     B5,CSE4     IF MORE WORDS TO CLEAR
          TNZ    B3,(/MCE/CSTX,MCE,/PROGRAM/PRG1)  IF NOT LIST
          SA1    A1+1        GET NEXT LIST ENTRY
          NZ     X1,CSE2     IF NOT END OF LIST
          TEQ    (/MCE/CSTX,MCE,/PROGRAM/PRG1)  EXIT
 
          ENDBLK
          BLOCK  UEC,(USER ECS PROCESSING ROUTINES.)
          SPACE  4
**        ASSEMBLE CONSTANTS.
 
 MECB     EQU    400B
          SPACE  4
**        MONITOR/UEC BLOCK EQUIVALENCES.
 
 CPE      EQU    /MONITOR/CPE
 MTRX     EQU    /MONITOR/MTRX
 SFL2     EQU    /MONITOR/SFL2
 UMT1     EQU    /MONITOR/UMT1
 UMTA     EQU    /MONITOR/UMTA
 MFX      SPACE  4,10
**        MFX - CHANGE FL FOR USER EXTENDED MEMORY.
*
*         ENTRY  (X0) = INCREMENT.
*                (B3) = ADDRESS OF CP USING CURRENT CPU.
*                (B6) = EXCHANGE PACKAGE ADDRESS.
*                (B7) = CP/PCP ADDRESS.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
 
 
 MFX      BSS    0           ENTRY
          SA3    B7+ECSW     READ FL CONTROL WORD
          TX6    UEM
          SA4    B7+3        SET UEM ENABLED FLAG
          LX6    56-0
          BX6    X4+X6
          SA6    A4
          IX7    X3+X0
          SA7    A3+         UPDATE FLX IN FL CONTROL WORD
          SA1    B6+4
          MX2    -36
          SA4    A1+B1
          BX4    -X2*X4
          MX2    -12
          BX6    -X2*X7      PICK UP INCREMENTED CP FLE
          TLX6   0,UESC
          TLX6   (36+3,ESM170,36+9)
          MX2    -24         MASK FOR RAE FROM *ECSW*
          BX7    X6+X4
          SA7    A4          WRITE UPDATED FLE TO EXCHANGE PACKAGE
          AX3    RSHF
          ZR     X6,MFX1     IF FLX = 0
          BX6    -X2*X3
 MFX1     SA4    UMTA
          SA3    UEML        FETCH UEM PRESENT STATUS
          TA2    X4+1,MCT
          IX7    X2-X0       ADJUST UNASSIGNED XM ABOVE CP/PCP
          BX4    X3
          SA7    A2          UPDATE MCT ENTRY
          MX2    -36
          LX4    59-1
          BX7    -X2*X1      XP RAX = *ECSW* RAX + UEM BASE ADDRESS
          MX2    12
          NG     X4,MFX2     IF UEM PRESENT
          SX3    B0
 MFX2     BX3    X2*X3       EXTRACT UEM BASE ADDRESS
          LX3    -3
          TLX6   36+9,UESC
          IX6    X3+X6
          TLX6   (60-6,ESM170,0)
          IX6    X7+X6
          ZR     B7,SFL2     IF SYSTEM EXTENDED MEMORY REQUEST
          SA6    A1+
          EQ     SFL2        CHECK CPU ACTIVITY
 MRX      SPACE  4,10
**        MRX - CHANGE RA FOR USER EXTENDED MEMORY.
*
*         ENTRY  (X0) = INCREMENT.
*                (B4) = EXIT ADDRESS FOR *UMT*.
*                (B7) = CP/PCP ADDRESS.
*
*         USES   X - 2, 7.
*                B - 5.
*                A - 2, 7.
 
 
 MRX      BSS    0           ENTRY
          SA2    B7+ECSW     READ FL CONTROL WORD
          LX0    12
          IX7    X2+X0       INCREMENT RAX
          SB5    1
          LX0    -12         RESTORE INCREMENT
          SA7    A2
          EQ     UMT1        UPDATE MEMORY CONTROL TABLE
          EJECT
          TITLE  USER ECS PROGRAM MODE ROUTINES.
          QUAL   PROGRAM
 MECB     SPACE  4,10
**        DEFINE BLOCK SIZE FOR USER ECS OPERATIONS.
 
 
 MECB     EQU    400B
 CEC      SPACE  4,10
**        CEC - CLEAR USER ECS STORAGE.
*         SET THE SPECIFIED AREA OF USER ECS TO ZERO.  THIS ROUTINE IS
*         EXECUTED IN PROGRAM MODE AND UTILIZES THE PROGRAM MODE
*         BUFFER FOR CLEARING ECS.
*
*         ENTRY  (A5) = PPU OUTPUT REGISTER ADDRESS.
*
*         EXIT   CLEAR OUTPUT REGISTER.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 0, 1, 2, 3, 7.
*                B - 4, 6.
*
*         MACROS PER, WUE.
 
 
 CEC      TSX0   (LCCB-1,CP176,1-1)
          SAC    18,CCMB     ADD CLEAR CENTRAL MEMORY BUFFER
          NZ     X0,CEC1     IF NOT CYBER 990 TYPE MAINFRAME
          SA2    ECRL        GET RAE FOR ZERO UEM BLOCK
          LX2    0-12
          MX0    -24
          BX0    -X0*X2
          TLX0   9-21+60,UESC
 CEC1     SA0    PBUF        SET FWA OF CM BUFFER
          TLX0   (0,CP176,21)
          SB4    MECB        SET WORD COUNT
          TLX0   (3,ESM170,0)
          TLX0   (4,UEM180,0)
          SA2    A5
          SX1    A0
          LX1    30
          BX0    X0+X1
+         RE     B4          CLEAR CM BUFFER
 
*         NOTE - HALF EXIT WILL BE TAKEN ON EXTENDED MEMORY READ
*                BECAUSE OF OUT-OF-RANGE ADDRESS SPECIFIED
*                TO CAUSE ZEROES TRANSFER TO CM.
 
          SB0    B0+
          SX0    X2          ECS ADDRESS/1000B
          LX2    59-42
          TLX0   9,UESC
          MX6    -RMSK
          PL     X2,CEC2     IF ABSOLUTE ADDRESS
          SA3    B7+ECSW     GET RAE
          LX3    -RSHF
          BX4    -X6*X3
          TLX4   9,UESC      RAE*(UEBS)
          IX0    X4+X0
 CEC2     LX2    -24-59+42
          SX3    X2          BLOCK COUNT
          ZR     X3,HNG      IF ZERO BLOCK COUNT
          TLX3   9,UESC      WORD COUNT
          BX0    X1+X0
          SX6    B4+
          SB6    CEC4        SET RETURN ADDRESS
 CEC3     WUE    PROGRAM     WRITE (B4) WORDS TO USER EM
          PER    /PROGRAM/CEC5
 CEC4     IX3    X3-X6       DECREMENT WORD COUNT
          IX0    X0+X6       INCREMENT ECS ADDRESS
          NZ     X3,CEC3     IF MORE TO CLEAR
 
*         STORAGE CLEARED, CLEAR PPU OR AD EXIT.
 
 CEC5     BX7    X7-X7
          TEQ    (/MCE/CSTX,MCE,/PROGRAM/PRG1)  EXIT
 MEC      SPACE  4,8
**        MEC - MOVE ECS STORAGE.
*
*         ENTRY  (B7) = CP/PCP ADDRESS.
*
*         USES   X - ALL.
*                B - 5.
*                A - ALL.
*
*         CALLS  PER.
 
 
 MEC      BSS    0           ENTRY
 
*         INITIALIZE MOVE PARAMETERS.
 
          SA2    B7+ECSW     GET RAE AND FLE
          TSA1   (UEML,UEM,ZERL)  GET UEM BASE ADDRESS
          SA5    SMIN
          MX0    -12
          MX6    -RMSK
          BX4    -X0*X2
          LX1    12
          AX2    RSHF
          BX1    -X0*X1
          BX2    -X6*X2
          LX1    9           UEM BASE ADDRESS IF UEM PRESENT
          TLX2   9,UESC
          TLX4   9,UESC      FLE IN WORDS
          IX2    X1+X2       RAE WORD ADDRESS
          TLX5   9,UESC      INCREMENT IN WORDS
          BX3    X5
          SX6    -MECB       WORD COUNT
          IX0    X2+X4
          IX0    X0+X6       SET FWA ECS TO READ FROM (RA+FL-BLOCK SIZE)
          SA0    UBUF        CM BUFFER ADDRESS
          PL     X5,MEC1     IF MOVING CP UP ( TOWARDS HIGH CORE )
          LX1    X0
          BX6    -X6
          LX0    X2          SET FWA ECS TO RAE FOR LOWER MOVE
          BX2    X1
 MEC1     IX6    X6-X3
          SX5    A0+
          LX5    30
          BX0    X5+X0
          MX5    -24
 
*         MAIN MOVE LOOP.
 
 MEC2     RE     MECB        READ ECS
          RJ     MEC3        IF EXTENDED MEMORY ERROR
          IX4    X0-X2
          IX0    X0+X3       SET FWA ECS TO WRITE TO
          WE     MECB        WRITE ECS
          RJ     MEC3        IF EXTENDED MEMORY ERROR
          IX0    X0+X6       SET NEXT ADDRESS TO READ FROM
          BX1    -X5*X4
          NZ     X1,MEC2     IF MORE BLOCKS TO MOVE
 
*         MOVE COMPLETED.
 
          TNO    /MCE/MEC,MCE  IF MEMORY CLEARING ENABLED
 MEC2.1   TA2    EMMS,SDA    GET EM MOVE COUNT
          SA5    SMIN        GET MOVE INCREMENT
          SA1    B7+ECSW     GET *ECSW*
          TSA3   (UEML,UEM,ZERL)  GET UEM BASE ADDRESS
          SA4    B7+4        GET EXCHANGE PACKAGE RAE
          SX7    B1
          MX0    -RMSK
          MX6    12
          LX0    12
          IX7    X7+X2       COUNT MOVE
          LX5    RSHF
          SA7    A2          UPDATE EM MOVE COUNT
          IX7    X1+X5       SET NEW RA IN *ECSW*
          BX3    X6*X3
          SA7    A1          UPDATE *ECSW*
          BX7    -X0*X7
          LX3    24          UEM BASE ADDRESS IF UEM PRESENT
          TLX7   0,UESC
          MX0    -36
          IX7    X7+X3
          BX4    -X0*X4
          TLX7   (24+3,ESM170,24+9)
          BX6    X4+X7
          BX7    X7-X7       CLEAR REPLY
          SA6    A4          UPDATE EXCHANGE PACKAGE RAE
          EQ     SMPX        RETURN
 
*         PROCESS EXTENDED MEMORY ERROR.
 
 MEC3     PS                 ENTRY/EXIT
          SX1    400B        WORD COUNT
          RJ     /ECS/RSE    REPORT STORAGE MOVE EXTENDED MEMORY ERROR
          SA1    SMRL        SET EXTENDED MEMORY ERROR STATUS
          SX7    B1
          LX7    36
          SB5    MEC3        *MSC* RETURN ADDRESS
          BX7    X1+X7
          SA7    A1
          SX1    MSEA        * EXTENDED MEMORY ERROR - STORAGE MOVE.*
          EQ     /MONITOR/MSC  ISSUE ERROR MESSAGE
 TEC      SPACE  4,10
**        TEC - PERFORM USER ECS TRANSFER FOR *ECXM* FUNCTION.
*
*         USES   X - ALL.
*                B - 3, 4, 5, 6, 7.
*                A - 0, 1, 2, 4, 6, 7.
*
*         MACROS PER, RUE, WUE.
 
 
 TEC      SA4    A5+B1       READ PARAMETERS
          AX2    24
          MX6    48
          SB7    X2          SET CP/PCP ADDRESS
          SX0    X4          ECS ADDRESS/1000B
          LX4    12          GET WORD COUNT
          BX3    -X6*X4
          LX0    9           ECA*1000B
          LX4    24          GET CM ADDRESS
          SB3    X3          SET WC FOR ECS TRANSFER
          BX4    -X6*X4
          MX7    1
          SA2    B7+ECSW     GET CP/PCP RAE,FLE
          LX7    -12
          BX7    X7+X2       SET *ECXM* STORAGE MOVE INTERLOCK
          SA7    A2
          BX7    -X6*X2      FLE
          LX2    -RSHF
          BX2    -X6*X2      RAE
          TLX7   9,UESC      FLE*(UEBS)
          IX3    X0+X3       ECA+WC
          TLX2   9,UESC      RAE
          IX0    X2+X0       RAE+ECA=ABSOLUTE ECS ADDRESS
          SA2    B7+FLSW
          IX1    X7-X3       FLE - (ECA + WC)
          BX7    -X6*X2      CM FL
          MX6    -RMSK
          AX2    RSHF
          BX2    -X6*X2      CM RA
          LX7    6           FL*100B
          LX4    6           CMA*100B
          SX3    X4+B3       CMA + WC
          IX7    X7-X3       FL-(CMA+WC)
          BX7    X1+X7
          NG     X7,HNG      IF CMA OR ECA OUT OF RANGE
          LX2    6           RA*100B
          IX4    X2+X4       RA+CMA
          BX7    X7-X7
          SA0    X4          SET ABSOLUTE FWA OF CM BUFFER
          LX4    30
          BX0    X4+X0
          SB5    X5+         SAVE RESPONSE ADDRESS
          SB4    MECB
          SB6    TEC3        SET RETURN ADDRESS
          LX5    59-18
          SA7    A5          CLEAR PP OUTPUT REGISTER NOW
 TEC1     GE     B3,B4,TEC2  IF NOT LAST SHORT BLOCK
          SB4    B3+
 TEC2     NG     X5,TEC4     IF WRITE
          RUE    PROGRAM     READ (B4) WORDS FROM USER ECS
          PER    /PROGRAM/TEC6  PARITY ERROR PROCESSOR
 TEC3     EQ     B3,B4,TEC5  IF END OF BLOCK
          SB3    B3-B4       DECREMENT WORD COUNT
          SX2    B4          INCREMENT ADDRESSES
          SA0    A0+B4
          IX0    X0+X2
          LX2    30
          IX0    X0+X2
          EQ     TEC1        LOOP FOR NEXT TRANSFER
 
 TEC4     WUE    PROGRAM     WRITE (B4) WORDS TO USER ECS
          PER    /PROGRAM/TEC6  PARITY ERROR PROCESSOR
 TEC5     NE     B3,B4,TEC3  IF NOT END OF BLOCK
          SA1    B7+ECSW     CLEAR *ECXM* STORAGE MOVE INTERLOCK
          MX6    59
          LX6    47-0
          BX6    X6*X1
          SA6    A1
          SA7    B5          SET RESPONSE
          EQ     PRG         EXIT
 
 TEC6     MX7    12          RETURN ERROR STATUS
          LX7    -12
          EQ     TEC5        RETURN
 UBUF     SPACE  4,10
*         USER ECS STORAGE MOVE BUFFER.
 
 UBUF     BSS    MECB
          SPACE  4
          QUAL   UEC
 
          ENDBLK
          BLOCK  VMS,(VALIDATE MASS STORAGE.)
 VMSM     SPACE  4,10
**        VMSM - VALIDATE MASS STORAGE.
*
*         ENTRY  (A5) = PPU OUTPUT REGISTER ADDRESS.
 
 
 VMS      SX4    X1
          AX4    12
          SB3    VMS1        *CTR* RETURN ADDRESS
          ZR     X4,/PROGRAM/CTR  IF INTERLOCKING MST/TRT
          AX4    1
          SB6    B0
          ZR     X4,/PROGRAM/CTR  IF VALIDATE WITH NO INTERLOCK
          SB3    VMS8        *CTR* RETURN ADDRESS
          EQ     /PROGRAM/CTR
 
*         VALIDATE EQUIPMENT.
 
 VMS1     BX2    -X5*X3      AVAILABLE TRACKS
          MX0    -4          (X0) = PRESERVED BIT MASK
          SA4    A3+B1       READ PRESERVED FILE COUNT
          SA1    B6          READ FIRST WORD OF TRT
          AX3    24
          AX4    24
          BX3    -X5*X3      TRT LENGTH
          BX4    -X4+X5      - PRESERVED FILE COUNT
          SB4    X3          (B4) = LENGTH OF TRT
          LX0    8
          SB2    B6+X3       (B2) = LWA+1 OF TRT, *VTC* ENTRY CONDITION
          LX3    2
          SB5    X4          (B5) = - PRESERVED FILE COUNT
          IX7    X2-X3
          MX4    -4          (X4) = RESERVATION BIT MASK
          SB3    X7          (B3) = - TRACKS RESERVED
 
*         COUNT RESERVATION AND PRESERVED FILE BITS.
 
 VMS2     SB7    X4          (B7) = -15 = LOOP COUNTER
          BX7    X7-X7
          SB4    B7+B4
          BX6    X6-X6
          PL     B4,VMS3     IF NOT LAST SHORT LOOP
          SB7    B7-B4       SET TO SHORT LOOP WORD COUNT
 VMS3     LX7    4
          BX5    -X0*X1      EXTRACT PRESERVED FILE BITS
          SB7    B7+B1
          BX6    X6+X5
          BX5    -X4*X1      EXTRACT RESERVATION BITS
          LX6    4
          SA1    A1+B1
          BX7    X7+X5
          NZ     B7,VMS3     IF NOT END OF LOOP
 
          CX6    X6          COUNT PRESERVED FILE BITS
          CX7    X7          COUNT RESERVATION BITS
          SB5    B5+X6
          SB3    B3+X7
          GT     B4,B0,VMS2  IF NOT END OF TRT
          SX3    B1
          MX0    -8
          SA4    A3+PUGL     CHECK FOR CATALOGS ON DEVICE
          BX7    X7-X7
          ZR     B3,VMS4     IF RESERVATION BIT COUNT OK
          BX7    X7+X3       SET ERROR FLAG
 VMS4     LX7    -1
          ZR     B5,VMS5     IF PRESERVATION BIT COUNT OK
          BX7    X7+X3       SET ERROR FLAG
 VMS5     BX2    -X0*X4      EXTRACT DEVICE MASK
          LX7    -4
          ZR     X2,VMS7     IF NO CATALOGS ON DEVICE
 
*         VALIDATE PERMIT, LABEL-CATALOG, IAF TRACK CHAINS.
 
          SB7    B1+B1
          SA2    A4-B7       READ FIRST TRACK OF CHAINS
          MX4    -11
          AX2    12
          SB3    VMS6        *VTC* RETURN ADDRESS
          LX7    4
          MX0    -2
 
*         VALIDATE INDIRECT ACCESS FILE CHAIN.
 
 VMS6     AX2    12
          LX7    -1
          BX6    -X0*X2
          BX1    -X4*X2
          SB7    B7-1
          NZ     X2,VTC      IF MORE CHAINS TO VALIDATE
 
*         RETURN STATUS, INTERLOCK DEVICE IF ERRORS.
 
 VMS7     SX3    B1          SET *CDI* ENTRY CONDITIONS
          BX1    X1-X1
          SX5    B1
          SB4    B0
          SB5    /PROGRAM/PRG
          TZR    X7,(/ISD/VMS1,ISD,/PROGRAM/CDI)  IF NO ERRORS
          LX3    4
          SA2    A3+B1       SET DEVICE ERROR IDLE
          BX6    X2+X3
          LX7    5+36
          SA6    A2
          TEQ    (/LSPMMF/VMS,LSPMMF,/ISD/VMS1,ISD,/PROGRAM/CSM1)  EXIT
 
*         VALIDATE TRACK CHAIN.
 
 VMS8     AX3    24          SET TRT LENGTH
          SB3    VMS9
          BX3    -X5*X3
          MX4    -11
          SB2    B6+X3       (B2) = LWA + 1 OF TRT
          MX0    -2
          BX7    X7-X7
          SB7    B1
          EQ     VTC1        VALIDATE TRACK CHAIN
 
 VMS9     LX7    36          RETURN STATUS
          SA7    A5
          EQ     /PROGRAM/PRG EXIT
 VTC      SPACE  4,15
**        VTC - VALIDATE TRACK CHAIN.
*         VTC VALIDATES A TRACK CHAIN TO INSURE ALL TRACKS ARE RESERVED,
*         NO CIRCULAR CHAIN EXISTS AND ALL TRACKS ARE WITHIN THE TRT.
*
*         ENTRY  ENTER AT VTC1 IF NOT TO CHECK PRESERVED FILE BIT.
*                (X0) = -3
*                (X1) = FIRST TRACK.
*                (X2) = TRACK IF ENTERED AT VTC.
*                (X4) = -3777B
*                (X6) = BITS 0 AND 1 OF TRACK IF ENTERED AT VTC.
*                (B2) = LWA + 1 OF TRT.
*                (B3) = EXIT ADDRESS.
*                (B6) = FWA OF TRT.
*                (B7) = 0 IF CHECKING CATALOG CHAIN.
*                (A3) = ADDRESS OF TDGL IN MST.
*
*         EXIT   (X7) = BIT 0 SET IF ERROR DETECTED IN CHAIN.
*
*         USES   X - 1, 3, 5, 6, 7.
*                B - 4, 5, 7.
*                A - 1.
 
 
 VTC      AX1    2
          SB4    X6+48       PRESERVATION BIT SHIFT COUNT
          SA1    B6+X1
          LX6    X1,B4
          PL     X6,VTC6     IF PRESERVATION BIT NOT SET
          BX1    -X4*X2
 
*         ENTER HERE IF NOT CHECKING PRESERVATION BIT.
 
 VTC1     SX3    B6-B2       SET NUMBER OF TRACKS
          BX1    -X4*X1
          LX3    2
          SB4    X1
 
*         TRACK VALIDATION LOOP.
 
 VTC2     BX1    -X4*X1      TRACK
          SX3    X3+B1
          BX6    -X0*X1      BYTE NUMBER
          SB5    X1
          NZ     B7,VTC3     IF NOT CHECKING CATALOG CHAIN
          NE     B4,B5,VTC5  IF TRACKS NON-CONTIGUOUS
 VTC3     SX1    B5
          SB5    X6+56       RESERVATION BIT SHIFT COUNT
          LX6    2           TRACK LINK SHIFT COUNT * 4
          SB4    X1+B1
          AX1    2
          SA1    B6+X1       READ TRT WORD
          LX5    X1,B5       POSITION RESERVATION BIT
          SB5    X6
          LX6    1           TRACK LINK SHIFT COUNT * 8
          BX5    X5*X3
          SB5    B5+X6       TRACK LINK SHIFT COUNT * 12
          SX6    A1-B2       CHECK OUT OF TRT
          LX1    X1,B5       POSITION TRACK LINK BIT
          BX6    X6*X5
          AX1    48
          PL     X6,VTC6     IF NOT RESERVED, OUT OF TRT, OR CIRCULAR
          NG     X1,VTC2     IF TRACK LINKED
          NZ     B7,VTC4     IF NOT CHECKING CATALOG CHAIN
          SA1    A3+ALGL
          SX5    B6-B2       TRT LENGTH
          LX1    -12
          LX5    2           SET NUMBER OF TRACKS
          BX1    -X4*X1      CATALOG TRACK COUNT FROM MST
          IX5    X3-X5       NUMBER OF TRACKS IN CATALOG CHAIN
          CX3    X1
          IX6    X1-X5
          SB4    X3
          PL     X6,VTC6     IF NOT ENOUGH CATALOG TRACKS
          NE     B4,B1,VTC6  IF CATALOG TRACK COUNT NOT POWER OF TWO
 VTC4     JP     B3          RETURN
 
 VTC5     SA1    A3+PUGL     CHECK CATALOG CHAIN CONTIGUOUS/OVERFLOW
          LX1    59-17
          PL     X1,VTC3     IF CATALOG CHAIN NON-CONTIGUOUS
          SA1    A3+ACGL
          LX1    59-57
          NG     X1,VTC3     IF CATALOG TRACK OVERFLOW
 VTC6     SX3    B1          RETURN ERROR STATUS
          BX7    X3+X7
          JP     B3          RETURN
 
          ENDBLK
          BLOCK  EUE,(ECS AND USER ECS PROCESSING ROUTINES.),ECS
 ECSM     SPACE  4
**        ECSM - ECS TRANSFER.
*
*         ENTRY  (A5) = PPU OUTPUT REGISTER ADDRESS.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                B - 3, 4, 5, 6.
*                A - 0, 1, 2, 3, 6.
*
*         CALLS  CFR, EAB, SFR.
*
*         MACROS PER, RUE, WUE.
 
 
 ECS      SB3    A0          SAVE CPU NUMBER
          LX5    59-23
          PL     X5,ECS2     IF OPTIONS 0 - 3
          LX1    -42
          LX2    X5,B1
          SB4    X1          LIST SIZE/BIT NUMBER
          LX5    X2,B1
          NG     X2,ECS1     IF OPTION 6 OR 7
          SB6    ECSX        *SFR*/*CFR* RETURN ADDRESS
          TPL    X5,(/ECS/SFR,EEC,/MONITOR/HNG)  IF *SFRS* FUNCTION
          TEQ    (/ECS/CFR,EEC,/MONITOR/HNG)  PROCESS *CFRS* FUNCTION
 
 ECS1     NG     X5,/MONITOR/HNG  IF OPTION 7
          LX5    1           NEGATIVE = WRITE ECS, POSITIVE = READ ECS
          MX2    1
          BX3    X2*X5
          LX2    -1
          BX2    X2*X5
          LX2    2
          SB5    X2          0 = ABS SYSTEM ECS, 1 = ABS USER ECS
          LX1    18
          SA1    X1          GET FIRST LIST ENTRY
          SX4    B4          INDICATE LIST SUBFUNCTION
          ZR     B4,/MONITOR/HNG  IF NO ENTRIES IN LIST
          MX5    -18
          SX2    A1+B4       CM ADDRESS OF DATA BUFFER
          BX2    -X5*X2
          BX5    X3+X2
          SX2    B0+
          EQ     ECS11       PRESET LIST REGISTERS
 
 ECS2     LX1    -24         CM ADDRESS OF BUFFER
          MX3    -17
          LX5    2           NEGATIVE = WRITE ECS, POSITIVE = READ ECS
          SX4    B1
          BX4    -X5*X4
          MX2    1
          BX5    X2*X5
          LX4    1
          SB5    X4          0 = ABS SYSTEM ECS, 2 = RELATIVE USER ECS
          BX3    -X3*X1
          LX1    -18
          MX6    -RMSK
          PL     X1,ECS3     IF ABSOLUTE CM ADDRESS
          SA2    B7+FLSW     ABSOLUTIZE CM BUFFER ADDRESS
          AX2    RSHF
          BX2    -X6*X2      RA/100
          LX2    6
          IX3    X3+X2
 ECS3     BX5    X5+X3
          LX1    42
          SX4    B0+         INDICATE NOT LIST SUBFUNCTION
          SB4    B1+         BIAS FOR WORD COUNT
          MX3    -21         ADDRESS MASK
 ECS4     MX6    -21
          BX0    -X3*X1      ECS ADDRESS
          MX3    -6
          LX1    -42
          BX1    -X3*X1      WORD COUNT
          SB4    X1+B4       WORD COUNT OF TRANSFER
          BX1    -X6*X5      CM ADDRESS OF BUFFER
          SA0    X1
          TX3    MECNF       MACHINE ECS FL / 1000B
          TLX3   60-0,-UESC
          ZR     B5,ECS6     IF ABSOLUTE SYSTEM ECS ADDRESS
          EQ     B5,B1,ECS5  IF ABSOLUTE USER ECS ADDRESS
          SA3    B7+ECSW     GET ECS RA AND FL
          MX2    -12
          BX6    -X2*X3
          AX3    RSHF
          TLX6   9,UESC
          MX2    -RMSK
          BX3    -X2*X3
          SX2    B4-B1
          TLX3   9,UESC
          IX2    X0+X2
          IX2    X2-X6
          IX0    X0+X3       ABSOLUTIZE ECS ADDRESS
          PL     X2,EAB3     IF ECA + WC .GT. FLX
 ECS5     TA3    ECSW,SCA    SET LWA+1 USER ECS / 1000B
          MX2    -12
          BX6    -X2*X3
          AX3    RSHF
          MX2    -RMSK
          BX3    -X2*X3
          IX3    X3+X6
 ECS6     TLX3   9,UESC
          SX2    B4-B1
          LX1    30
          IX2    X0+X2       LWA OF TRANSFER
          BX0    X1+X0
          IX2    X2-X3
          SX3    B1+
          SX6    A1          SAVE LIST ENTRY ADDRESS
          SA6    ECSA
          BX6    X6-X6
          PL     X2,EAB10    IF ILLEGAL ADDRESS
          SB6    ECS10       SET RETURN ADDRESS
          NZ     B5,ECS8     IF USER EXTENDED MEMORY READ/WRITE
          NG     X5,ECS7     IF WRITE SYSTEM ECS
+         RE     B4          READ (B4) WORDS FROM SYSTEM ECS
          PER    EAB         PROCESS EXTENDED MEMORY ERROR
          EQ     ECS10       COMPLETE PROCESSING
 
 ECS7     WE     B4          WRITE (B4) WORDS TO SYSTEM ECS
          PER    EAB         PROCESS EXTENDED MEMORY ERROR
          EQ     ECS10       COMPLETE PROCESSING
 
 ECS8     NG     X5,ECS9     IF WRITE USER ECS
          RUE    MONITOR     READ (B4) WORDS FROM USER ECS
          PER    EAB         PROCESS EXTENDED MEMORY ERROR
          EQ     ECS10       COMPLETE PROCESSING
 
 ECS9     WUE    MONITOR     WRITE (B4) WORDS TO USER ECS
          PER    EAB         PROCESS EXTENDED MEMORY ERROR
 ECS10    ZR     X4,ECSX     IF NOT PROCESSING LIST
          SA1    ECSA        GET LIST ENTRY ADDRESS
          SA6    X1+         SET/CLEAR ERROR FLAGS
          SX2    B4+         ADVANCE CM BUFFER ADDRESS
          SA1    A6+B1       GET NEXT LIST ENTRY
          IX4    X4-X3
          ZR     X4,ECSX     IF END OF LIST
 ECS11    IX5    X5+X2
          SB4    B0+
          TMX3   (36,ESM170,39)
          EQ     ECS4        PROCESS NEXT LIST ENTRY
 
 
 ECSA     CON    0           LIST ENTRY ADDRESS
 EAB      SPACE  4,20
**        EAB - ECS ABORT PROCESSOR. (MONITOR MODE)
*
*         ENTRY  (X0) = ECS ADDRESS OF ERROR.
*                (X3) = 1.
*                (X4) = 0 IF NOT PROCESSING LIST.
*                (X5) .LT. 0 IF WRITE ECS, OTHERWISE READ ECS.
*                (X6) = 0.
*                (X7) = 0 OR ERROR STATUS.
*                (B3) = CPU NUMBER.
*                (B4) = WORD COUNT OF TRANSFER.
*                (A0) = CM ADDRESS OF TRANSFER.
*                (A5) = OUTPUT REGISTER ADDRESS.
*
*         EXIT   (X6) = ERROR FLAGS FOR LIST ENTRY.
*                TO *ECS10* IF PROCESSING LIST.
*                TO *PPRX* IF FUNCTION COMPLETE.
*
*         USES   A - 0, 7.
*                B - 6, 7.
*                X - 0, 1, 2, 6, 7.
 
 
*         PROCESS EXTENDED MEMORY ERROR.
 
 EAB      NZ     X4,EAB4     IF PROCESSING LIST
          MX7    12          SET ERROR STATUS
          LX7    -12
 EAB1     MX6    -24
          BX0    -X6*X0
          BX7    X7+X0
 EAB2     SA0    B3          RESTORE CPU NUMBER
          SA7    A5          STORE RESPONSE
          EQ     /MONITOR/PPRX  EXIT
 
*         PROCESS INVALID RELATIVE ADDRESS.
 
 EAB3     SX7    B1          SET ERROR STATUS
          LX7    36
          EQ     EAB1        RETURN ERROR STATUS
 
*         PROCESS EXTENDED MEMORY ERROR DURING LIST PROCESSING.
 
 EAB4     SX1    B1
          LX1    30
          BX1    X3+X1
          SB6    B4
 EAB5     SB7    B4-B6
          SB6    B6-B1
          NG     X5,EAB8     IF WRITE ECS
+         RE     1           RETRY READ ONE WORD AT A TIME
          EQ     EAB9        PROCESS EXTENDED MEMORY ERROR
 EAB6     SA0    A0+B1
          IX0    X0+X1
          NZ     B6,EAB5     IF NOT END OF BUFFER
 EAB7     MX7    12          INDICATE TRANSFER ABORTED
          LX7    -12
          EQ     ECS10       CONTINUE PROCESSING LIST
 
 EAB8     WE     1           RETRY WRITE ONE WORD AT A TIME
          EQ     EAB9        PROCESS EXTENDED MEMORY ERROR
          EQ     EAB6        CONTINUE RETRY FOR ENTIRE BUFFER
 
 EAB9     LX2    X3,B7
          BX6    X6+X2       SET ERROR FLAG FOR THIS WORD
          EQ     EAB6        CONTINUE RETRY FOR ENTIRE BUFFER
 
*         PROCESS INVALID ECS ADDRESS IN LIST.
 
 EAB10    ZR     X4,/MONITOR/HNG  IF ILLEGAL ADDRESS AND NOT LIST
          MX6    60          RETURN ERROR STATUS IN ALL BITS
          MX7    12          INDICATE TRANSFER ABORTED
          LX7    -12
          EQ     ECS10       CONTINUE PROCESSING LIST
 
 ECSX     EQU    EAB2        EXIT ADDRESS FOR *ECS*
 
          ENDBLK
          BLOCK  ECS,(ECS PROCESSING ROUTINES.)
 PIOM     SPACE  4,10
**        PIO - *PIOM* PP I/O CPU TRANSFERS (MONITOR MODE).
*
*         ENTRY  (A0) = CPU NUMBER.
*                (A5) = *OR* ADDRESS.
*                (B2) = EXCHANGE PACKAGE ADDRESS.
*                (B7) = CP ADDRESS.
*                (B5) = SUBFUNCTION - 1.
*                (X2) = MASK OF -12.
*                (X5) = (OR).
*                (X7) = 0.
*                SEE *PIOM* DOCUMENTATION FOR *OR*, *MB* AND *MB*+1
*                   DESCRIPTION.
*
*         EXIT   A0, A5, B2, B7 SAME AS ON ENTRY.
*                TO /MONITOR/HNG, FOR FOLLOWING CONDITIONS -
*                   (1)  ILLEGAL SUBFUNCTION
*                   (2)  BUFFER PREVIOUSLY RESERVED FOR SUBFUNCTION 0
*                        (RESERVE WRITE BUFFER)
*                   (3)  PP BUFFER RESERVED BUT NOT INTERLOCKED
*                        TO THIS PP.
*                   (4)  PP BUFFER NOT PREVIOUSLY RESERVED FOR
*                        SUBFUNCTION 2 (WRITE PRU).
*                   (5)  BUFFERED I/O REQUEST WITHOUT
*                        *BUFIO* BLOCK PRESENT.
*                   (6)  FUNCTION FLAG SELECTION NOT LEGAL FOR THIS
*                        SUBFUNCTION.
*                TO /BUFIO/PBF, FOR SUBFUNCTION 5 (I/O BUFFER FLUSH),
*                   AFTER SWITCH TO PROGRAM MODE.
*                TO /PROGRAM/PDT, FOR ECS DIRECT TRANSFER,
*                   AFTER SWITCH TO PROGRAM MODE.
*                TO /BUFIO/PST, FOR BUFFERED DEVICE DIRECT TRANSFER,
*                   AFTER SWITCH TO PROGRAM MODE.
*                TO /BUFIO/PST, IF BUFFERED I/O PRU TRANSFER.
 
 
 PIO      TX1    A5-1,-FP
          SA3    CMCL
          LX1    PPXES-PPCES
          SA4    A5+B1       GET PARAMETERS FROM MESSAGE BUFFER
          TA1    X1+ACPP,FPX GET CP ASSIGNMENT
          SA7    A4+1
          SB4    FLBS-1
          BX3    X1-X3
          TSB6   (/BUFIO/PBF,BUFIO,/PROGRAM/HNG)
          AX3    48
          SX1    REIS        RETURN STATUS = *PAUSE* REQUIRED
          ZR     X3,PIOX     IF STORAGE MOVE REQUIRED
          EQ     B5,B4,PIOP  IF I/O BUFFER FLUSH
          GE     B5,B4,/MONITOR/HNG  IF ILLEGAL SUBFUNCTION
          LX4    24          POSITION EST ORDINAL
          BX0    -X2*X4
          LX4    -12         POSITION PP I/O BUFFER
          CX1    X0,EST      CONVERT EST ORDINAL TO OFFSET
          TA1    X1+EQDE,EST READ EST ENTRY
          BX1    -X2*X1      GET MST ADDRESS FOR EQUIPMENT
          LX1    3
          SA1    X1+DILL     GET BUFFERED DEVICE FLAG
          SX0    B1+
          BX3    -X2*X4      PP I/O BUFFER INCREMENT
          LX1    0-22
          BX6    X0*X1
          SA6    A4+B1       SAVE DEVICE INDICATOR IN MESSAGE BUFFER
          SA1    PFFV        VALIDATE FUNCTION FLAGS
          SB3    B5+B1
          SB6    B3+B3
          LX5    18
          SB6    B6+B3
          SB6    B6+B6
          LX1    B6
          BX1    X1*X5
          MX6    6
          BX6    X6*X1
          LX5    -18
          NZ     X6,/MONITOR/HNG  IF ILLEGAL FUNCTION FLAGS
          BX6    X4
          LX6    59-6-12
          NG     X6,PIO6     IF RECALL AFTER FLUSH
          BX6    X2*X4       CLEAR PP I/O BUFFER INCREMENT
          LX4    59-0-12
          LX6    -12
          PL     X4,PIO4     IF PP I/O BUFFER NOT RESERVED
 
*         VALIDATE PP I/O BUFFER INTERLOCK.
 
          SX1    A5
          TA3    X3,ECSB     CHECK PP I/O BUFFER INTERLOCK
          NG     B5,/MONITOR/HNG  IF RESERVE WRITE BUFFER SUBFUNCTION
          IX1    X3-X1
          BX6    -X0*X6      CLEAR PP I/O BUFFER RESERVED FLAG
          NZ     X1,/MONITOR/HNG  IF NOT RESERVED TO THIS PP
          LE     B5,B1,PIO6  IF NOT DIRECT TRANSFER
 
*         RELEASE PP I/O BUFFER AND SWITCH TO PROGRAM MODE
*         FOR DIRECT TRANSFER (SF = 3, 4).
 
          SA7    A3          CLEAR PP I/O BUFFER INTERLOCK
          SA6    A4
 PIO2     LX4    59-8-59+0
          SA1    A4+B1       GET DEVICE INDICATOR
          NG     X4,PIO3     IF NOT INITIAL CALL
          LX0    8
          BX6    X0+X6
          SA6    A4+
 PIO3     SB6    /PROGRAM/PDT
          ZR     X1,PIOP     IF ECS REQUEST
          TSB6   (/BUFIO/PST,BUFIO,/PROGRAM/HNG)
          EQ     PIOP        SWITCH TO PROGRAM MODE
 
*         RESERVE PP I/O BUFFER (SF = 0, 1).
 
 PIO4     GT     B5,B1,PIO2  IF DIRECT TRANSFER
          EQ     B5,B1,/MONITOR/HNG  IF SECTOR WRITE
          TX1    B0,ECSBL    GET PP I/O BUFFER LENGTH
          SX7    A5
          BX6    X0+X6       SET PP I/O BUFFER RESERVED FLAG
 PIO5     SX1    X1-ECBL
          NG     X1,PIOR     IF NO PP BUFFER AVAILABLE
          TA3    X1,ECSB     CHECK BUFFER INTERLOCK
          NZ     X3,PIO5     IF BUFFER RESERVED
          LX1    -12
          BX6    X6+X1       SET PP I/O BUFFER INCREMENT
          SA7    A3          SET PP BUFFER INTERLOCK
          SA6    A4
 
*         PROCESS ECS PRU TRANSFER.
 
 PIO6     TA1    EQDE,EEN    CHECK TRACK COUNT
          BX1    -X2*X1
          LX1    3
          SA1    X1+TDGL
          LX4    0-12-59+0+60
          SB6    A0          SAVE (A0)
          BX3    -X2*X4      SECTOR
          LX1    12
          BX6    -X2*X1      TRACK COUNT
          SA1    A4+B1
          TNZ    X1,(/BUFIO/PST,BUFIO,/MONITOR/HNG)  IF BUFFERED
          NG     B5,PIOX     IF RESERVE BUFFER SUBFUNCTION
          TB3    0,-TCNT
          SX0    X3+B3
          PL     X0,PIO6.1   IF SECTOR .GT. LIMIT
          LX6    1
          LX4    -11
          LX7    X3
          BX0    -X2*X4      TRACK * 2
          LX7    6           SECTOR * 100B
          IX1    X0-X6
          PL     X1,PIO6.1   IF TRACK .GT. LIMIT
          SA0    A3+1        LINKAGE WORD ADDRESS
          BX6    -X2*X4
          TLX0   9,TNSC      TRACK * WORDS PER TRACK
          IX7    X7-X3       SECTOR * 77B
          TLX6   3,TNSC      TRACK * SECTORS PER TRACK
          TX7    X7,TCNT
          IX0    X0+X6       TRACK * WORDS + LINKAGE WORDS
          SX1    -DSTE       SET *DEVICE ERROR* STATUS
          IX0    X0+X3       HEADER ADDRESS = TRACK * WORDS + SECTOR
          SX2    A0
          LX2    30
          BX0    X2+X0
          EQ     B5,B1,PIO7  IF WRITE SECTOR SUBFUNCTION
          RE     1           READ HEADER WORD
          PER    PIOX3       PROCESS ECS PARITY ERROR
          SX1    PARE        SET *PARITY ERROR* STATUS
          SA0    A0+B1       INCREMENT ADDRESSES
          IX0    X0+X7       TRACK*WORDS + SECTOR*100B + TCNT
          SX2    B1+
          LX2    30
          IX0    X0+X2
          RE     100B        READ SECTOR OF DATA
          PER    PIOX3       PROCESS ECS PARITY ERROR
          SA0    B6          RESTORE (A0)
          BX1    X1-X1       RETURN STATUS = NO ERROR
          EQ     PIOX        EXIT
 
 PIO6.1   SX1    -ADDE       SET *ADDRESS ERROR* STATUS
          EQ     PIOX        RETURN ERROR STATUS
 
 PIO7     WE     1           WRITE HEADER WORD
          PER    PIOX3       PROCESS ECS PARITY ERROR
          BX2    X5
          SX1    PARE        SET *PARITY ERROR* STATUS
          LX2    59-37       RELEASE PP BUFFER IF FLUSH BIT SET
          SA0    A0+B1       INCREMENT ADDRESSES
          AX2    59
          IX0    X0+X7       DATA ADDRESS=TRACK*2020B+SECTOR*100B+20B
          BX1    X1-X2
          SX3    B1+
          LX3    30
          IX0    X0+X3
          WE     100B        WRITE SECTOR OF DATA
          PER    PIOX3       PROCESS ECS PARITY ERROR
          SA0    B6          RESTORE (A0)
          BX1    X2          RETURN STATUS = NO ERROR
          EQ     PIOX        EXIT
 
 
 PFFV     VFD    6/4,6/7,6/4,6/3,6/5,30/0  FUNCTION FLAG VALIDATIONS
 PIOX     SPACE  4,10
**        PIOX - EXIT FROM *PIOM*.
*
*         ENTRY  (A5) = PP *OR* ADDRESS.
*                (A0) = CPU NUMBER, IF ENTRY AT *PIOX*, *PIOX1*,
*                      OR *PIOX2* FROM MONITOR MODE.
*                (B6) = CPU NUMBER, IF ENTRY AT *PIOX3*.
*                (X0) = ADDRESS OF UNRECOVERED ECS PARITY ERROR,
*                   IF ENTRY AT *PIOX3*.
*                (X1) = RETURN STATUS.
*                (X1) = COMPLEMENT OF RETURN STATUS,
*                   IF PP BUFFER TO BE RELEASED.
*                (X5) = (OR), IF ENTRY AT *PIOX1*, *PIOX2*, OR *PIOX3*.
*                (MB+1) .LT. 0, IF PROGRAM MODE EXIT.
 
 
 PIOX3    MX2    30          RETURN ECS PARITY ERROR ADDRESS
          BX6    X2*X5
          BX0    -X2*X0
          BX6    X6+X0
          SA6    A5+
          SA0    B6+         RESTORE (A0)
 
 PIOX     SA5    A5+
          MX2    -36
          LX1    -24
          BX5    -X2*X5
          PL     X1,PIOX2    IF NO RELEASE OF PP BUFFER
          BX1    -X1
 PIOX1    SA4    A5+B1
          BX7    X7-X7
          MX2    12
          BX3    X2*X4       PP I/O BUFFER INCREMENT
          BX4    -X2*X4      CLEAR PP I/O BUFFER INCREMENT
          LX4    59-0
          PL     X4,PIOX2    IF NO PP BUFFER ASSIGNED
          LX3    12
          MX2    -59
          BX6    -X2*X4      CLEAR BUFFER RESERVATION FLAG
          LX6    0-59
          TX3    X3,ECSB     FWA PP BUFFER
          SA6    A4
          SA7    X3
 PIOX2    SX6    B1
          BX7    X5+X1
          SX3    A5+B1
          LX6    46-0
+         SA3    X3+B1       **** PERFORM IN ONE WORD ****
          BX6    X6*X3       **** PERFORM IN ONE WORD ****
          BX6    X7+X6       **** PERFORM IN ONE WORD ****
          SA6    A3          **** PERFORM IN ONE WORD ****
          NG     X3,/PROGRAM/PRG1  IF EXIT FROM PROGRAM MODE
          EQ     /MONITOR/PPR1  EXIT FROM MONITOR MODE
 PIOR     SPACE  4,10
**        PIOR - REISSUE *PIOM* REQUEST.
*
*         ENTRY  (A5) = PP *OR* ADDRESS.
*                (B5) = *PIOM* SUBFUNCTION - 1.
*                (MB+1) .LT. 0, IF EXIT FROM PROGRAM MODE.
*
*         EXIT   TO /ECS/PIOX1, IF PP BUFFER NOT TO BE RELEASED.
*                TO /ECS/PIOX2, IF PP BUFFER TO BE RELEASED.
 
 PIOR     SA5    A5          SET BIT 59 OF *OR* FOR REISSUE
          MX1    1
          EQ     B5,B1,PIOX2 IF WRITE PRU FUNCTION
          EQ     PIOX1       RELEASE PP BUFFER
 PIOP     SPACE  4,10
**        PIOP - SWITCH TO PROGRAM MODE *PIOM*.
*
*         ENTRY  (A0) = CPU NUMBER.
*                (A5) = PP *OR* ADDRESS.
*                (B6) = PROGRAM MODE PROCESSOR ADDRESS.
*
*         EXIT   TO /PROGRAM/PMR.
 
 
 PIOP     SX6    B6          SAVE PROGRAM MODE RETURN ADDRESS
          SA3    A5+2        SET PROGRAM MODE FLAG
          LX6    18
          MX1    1
          BX6    X6+X3
          SA5    A5
          BX6    X6+X1
          SA6    A3
          EQ     /MONITOR/PMR  SWITCH TO PROGRAM MODE
          TITLE  ECS PROGRAM MODE ROUTINES.
          QUAL   PROGRAM
 PDT      SPACE  4,10
**        PDT - *PIOM* ECS DIRECT TRANSFER (SF = 3, 4).
*
*         ENTRY  IN PROGRAM MODE ONLY.
*                REFER TO *PIP* EXIT CONDITIONS.
*
*         EXIT   TO /PROGRAM/HNG, IF ILLEGAL SECTOR OR A SHORT SECTOR
*                   WAS ENCOUNTERED AND NOT READING TO EOR.
*                TO /ECS/PIOX, IF UNRECOVERED HARDWARE ERROR, ADDRESS
*                   ERROR OR TRANSFER COMPLETE.
 
 
 PDT11    SX1    ADDE        SET *ADDRESS ERROR* STATUS
          EQ     /ECS/PIOX   RETURN ERROR
 
 PDT      SA5    A5          VALIDATE *OR* PARAMETERS
          SB7    X5
          TA4    EQDE,EEN    CHECK TRACK COUNT
          MX0    -12
          BX4    -X0*X4
          LX4    3
          SA4    X4 + TDGL
          ERRNZ  TDGL
          LX5    -18
          LX4    12
          BX0    -X0*X4      TRACK COUNT
          SX6    X5
          NG     B7,HNG      IF ILLEGAL ADDRESS
          LX0    1
          MX2    -12
          SA4    A5+B1       FETCH *MB* PARAMETERS
          NG     X6,HNG      IF ILLEGAL SECTOR COUNT / LWA+1
          LX4    -12
          BX3    -X2*X4      CURRENT SECTOR
          SB7    B1+B1
          LX4    -11
          SB3    X3
          BX4    -X2*X4      CURRENT TRACK * 2
          IX0    X0-X4
          TB6    TCNT
          NG     X0,PDT11    IF TRACK .GT. LIMIT
          BX0    X4
          SX7    B5-B7
          GE     B3,B6,PDT11 IF ILLEGAL SECTOR
          SA2    RWEI+X7     GET ECS TRANSFER INSTRUCTION
          TLX0   4-1,TNSC    TRACK * SECTOR LIMIT
          TA0    TKLB,TCNT   = *TKLW*
          TLX4   10-1,TNSC
          BX7    X2
          IX0    X0+X4       WORDS/TRACK + LINK WORDS
          LX5    59-38+18
          AX6    24-18
          SA7    PETA        STORE READ / WRITE INSTRUCTION
          SX1    DSTE        SET *DEVICE ERROR* STATUS
          SX7    B0+         CLEAR EOR READ INDICATOR
          SA7    PAS4
          EQ     B5,B7,PDT1  IF READ REQUEST
          SB4    B6-B3       SECTOR COUNT TO END OF TRACK
          SB2    A0-B6       (B2) = *TKLB*
          SX2    A0+
          LX2    30
          BX0    X2+X0
          RE     B6          PRESERVE LINKAGE WITHIN TRACK
          PER    /ECS/PIOX   PROCESS PARITY ERROR
          SB3    B0
          IX0    X0+X3
          SA0    B2+X3
          MX7    -24
          BX0    -X7*X0
          SX2    A0
          LX2    30
          BX0    X2+X0
          WE     B4          TRANSFER LINKAGE WORDS THRU ECS
          PER    /ECS/PIOX   PROCESS PARITY ERROR
          ZR     X3,PDT6     IF FILE ON TRACK BOUNDARY
          SB3    B6          SET LINKAGE BUFFER OFFSET
          SA0    A0+B6
          BX0    -X7*X0
          SX2    A0
          LX2    30
          BX0    X2+X0
          RE     B4          ASSEMBLE LINKAGE BUFFER
          PER    /ECS/PIOX   PROCESS PARITY ERROR
 PDT1     PL     X5,PDT6     IF NOT READ TO EOR
          MX6    59          (X6) = -1
          SB4    B6          SET TO READ LINKAGE
          BX2    X4
          SB2    60-7
          EQ     PDT3        SEARCH FOR EOR
 
 PDT2     SB3    B0+         RESET LINKAGE INDEX
          LX1    42-59
          MX7    -11-4
          AX1    48-4
          PL     X1,HNG      IF BAD SECTOR LINKAGE
          BX2    -X7*X1
          SX0    X2+         TRACK * 20B
          SA6    A1
          TLX0   0,TNSC      COMPUTE LINK WORDS PER TRACK
          TLX2   6,TNSC      COMPUTE WORDS PER TRACK
          SX1    -DSTE       SET *DEVICE ERROR* STATUS
          IX0    X0+X2       LINKAGE ADDRESS
 PDT3     MX5    -24
          BX0    -X5*X0
          SX5    A0+
          LX5    30
          BX0    X5+X0
          RE     B4          READ LINKAGE
          PER    /ECS/PIOX   PROCESS PARITY ERROR
 PDT4     EQ     B3,B6,PDT2  IF END OF TRACK
          TA1    B3+TKLB,TCNT  CHECK SECTOR LINKAGE
          SB3    B3+B1       ADVANCE SECTOR NUMBER
          BX0    X1
          LX1    59-42
          SX6    X6+B1       ADVANCE SECTOR COUNT
          BX7    X7-X7
          AX0    48-0
          ZR     X0,PDT4.1   IF EOF OR EOI TRACK
          NG     X1,PDT4     IF NOT EOR
          AX7    X1,B2       SHORT SECTOR WORD COUNT
 PDT4.1   TLX2   36-10,-TNSC  POSITION EOR TRACK
          SX5    B3-B1
          IX7    X2+X7
          LX5    18          POSITION EOR SECTOR
          BX7    X7+X5
          SA7    A2-B7       SAVE WORD COUNT + EOR TRACK AND SECTOR
          ERRNZ  PAS4+2-RWEI CODE DEPENDS ON VALUE
          NE     B3,B6,PDT5  IF NEXT SECTOR WITHIN TRACK
          LX1    42-59
          MX7    -11-4
          SB3    B0          SET NEXT SECTOR
          AX1    48-4
          BX2    -X7*X1      EXTRACT NEXT TRACK
          LX2    36-4
 PDT5     SX5    B3          SAVE FILE POSITION AFTER EOR
          AX2    36-12
          BX7    X2+X5
          SA7    A7+B1
 PDT6     SB2    X3          CURRENT SECTOR
          BX5    X6          SECTOR COUNT
          SX1    B1
          BX6    X6-X6
          ZR     X3,PDT7     IF CURRENT POSITION ON TRACK BOUNDARY
          SX6    B6-B2       SECTOR COUNT FOR PASS 1
          IX2    X5-X6
          PL     X2,PDT7     IF PASS 1 .GE. TOTAL REQUEST
          BX6    X5
          SX1    B0
 PDT7     IX2    X5-X6       SECTORS REMAINING AFTER PASS 1
          BX7    X2
          SA6    PAS1
          TLX7   3,-TNSC      TRACK COUNT FOR PASS 2
          AX7    7
          IX1    X1+X7
          SA7    A6+B1
          TLX7   4,TNSC
          IX7    X2-X7       SECTOR COUNT FOR PASS 3
          TLX4   60-10,-TNSC
          BX2    X1+X7
          SA7    A6+B7
          NZ     X2,PDT8     IF PASS 2 AND/OR PASS 3 SET
          SA7    A6          CLEAR PASS 1
          SA6    A6+B7       SET PASS 3 = PASS 1
 PDT8     TX1    A5-1,-FP
          SB4    MECB        BLOCK TRANSFER SIZE
          LX1    PPXES-PPCES
          BX6    X5          SECTOR COUNT
          TA1    X1+ACPP,FPX GET CP/PCP ASSIGNMENT
          SA5    A5+
          MX2    -12
          AX1    24
          SA3    X1+FLSW     GET RA AND FL OF CP/PCP
          BX1    -X2*X3      FL/100B
          LX3    -RSHF
          MX2    -RMSK
          BX3    -X2*X3      RA/100B
          LX1    6           FL
          BX7    X5          OUTPUT REGISTER
          LX3    6           RA
          SB2    X5          RELATIVE CM ADDRESS
          LX7    59-38
          BX2    X6
          SB6    X1          FL
          SA0    X3+B2       ABSOLUTE CM ADDRESS
          SX0    X5
          IX3    X3+X0
          SX0    X6+
          PL     X7,PDT10    IF NOT READ TO EOR
          SA1    PAS4
          SX0    X1+
          ZR     X0,PDT9     IF NO SHORT SECTOR
          SX2    X2+B1       ADVANCE SECTOR COUNT
          IX5    X5+X1       ADVANCE CM ADDRESS
 PDT9     AX7    59-38+18
          SB2    X7
          GT     B2,B6,PET7  IF LWA+1 OF TRANSFER .GT. FL
          BX0    X0-X0
          ZR     B2,PDT10    IF LWA+1 OF TRANSFER NOT SPECIFIED
          SB6    X7          CHANGE FL CHECK
 PDT10    LX6    6           WORD COUNT = SECTOR COUNT * 100B
          IX5    X5+X6       ADVANCE CM ADDRESS IN *OR*
          LX0    24
          SB2    X5
          GT     B2,B6,PET7  IF LWA+1 OF TRANSFER .GT. FL
          IX7    X5-X0       DECREMENT SECTOR COUNT IN *OR*
          SA1    A5+B1
          NG     B2,HNG      IF ILLEGAL LWA+1 SPECIFICATION
          LX2    48
          SA7    A5
          MX5    12
          IX6    X1+X2       UPDATE SECTORS TRANSFERED IN *MB*
          BX6    X5*X6       CLEAR POSSIBLE OVERFLOW INTO *CHRV*
          BX2    -X5*X1      CLEAR OLD SECTOR COUNT
          BX6    X6+X2       MERGE NEW SECTOR COUNT
          SX5    B7+B7
          TLX5   0,TNSC
          SB6    X5          BLOCK COUNT
          ERRNZ  2000B/MECB-4  CODE DEPENDS ON VALUE
          SA6    A1+
          SX7    PET2        SET RETURN FROM READ/WRITE PROCESSOR
          SA7    PETB
          SA2    PAS2
          MX7    12
          SB2    X2          TRACK COUNT FOR PASS 2
          LX7    -36
          SA2    A2-B1
          BX5    X7*X6       EXTRACT CURRENT SECTOR
          AX5    12-6
          ZR     X2,PET      IF NO PASS 1
          SB2    B2+B1
          BX6    -X7*X6      CLEAR CURRENT SECTOR
          SB6    X2          SECTOR COUNT FOR PASS 1
          SB4    100B        BLOCK TRANSFER SIZE
          SA6    A6
 
*         PROCESS ECS TRANSFER.
 
 PET      ZR     B2,PET3     IF END OF FULL TRACK TRANSFERS
          TX0    X5,TCNT
          TLX4   4,TNSC      TRACK * LINKAGE WORDS PER TRACK
          IX0    X0+X4
          LX4    6           TRACK * WORDS PER TRACK
          IX0    X0+X4
 PET1     MX7    -24
          BX0    -X7*X0
          BX7    X3
          LX7    30
          BX0    X0+X7
          SX1    PARE        SET *PARITY ERROR* STATUS
          SB6    B6-B1       DECREMENT BLOCK COUNT
 PETA     RE     B4          READ ECS BLOCK
*         WE     B4          (WRITE ECS BLOCK)
          PER    /ECS/PIOX   PROCESS PARITY ERROR
          SX7    B4
          IX3    X7+X3       ADVANCE CM ADDRESS
          SA0    X3
          IX0    X0+X7       ADVANCE ECS ADDRESS
          NZ     B6,PET1     IF NOT END OF TRANSFER
          SA1    PETB
          BX5    X5-X5       SET NEXT SECTOR = 0
          SB4    X1          RETURN ADDRESS
          JP     B4          EXIT TO POST PROCESSOR
 
*         SET NEXT TRACK.
 
 PET2     TLX4   60-10,-TNSC  REPOSITION TRACK NUMBER
          MX6    -2
          BX7    -X6*X4      TRT BYTE INDEX
          AX2    B7,X4       TRT WORD INDEX
          SB4    MECB        WORD COUNT PER ECS ACCESS
          TA4    TRLL,EMS    CALCULATE TRT ADDRESS
          IX4    X2+X4
          SA2    X4          READ TRT WORD
          SB2    B2-B1       DECREMENT TRACK COUNT
          LX7    2           BYTE INDEX * 4
          LX4    B1,X7       BYTE INDEX * 8
          IX4    X7+X4       BYTE INDEX * 12
          SB6    X4          SET SHIFT COUNT
          MX6    -11
          LX4    B6,X2       POSITION NEXT TRACK
          AX4    48
          PL     X4,HNG      IF NO NEXT TRACK
          SX1    B7+B7
          TLX1   0,TNSC
          SB6    X1          BLOCK COUNT
          ERRNZ  2000B/MECB-4  CODE DEPENDS ON VALUE
          BX4    -X6*X4      REMOVE TRACK BIT
          EQ     B5,B7,PET   IF READ REQUEST
          MX6    1
          LX4    48
          SA0    B3+TKLB     ADDRESS OF LINKAGE BUFFER
          BX1    X6+X4
          LX6    1-18        WORD COUNT = 100B
          SX7    2020B
          TLX7   0,TNSC
          IX0    X0-X7       ECS ADDRESS FOR SECTOR LINKAGE
          BX6    X1+X6
          R=     X1,ERRS     RETURN STATUS = UNRECOVERABLE ERROR
          TA6    A0-1,TCNT
          MX7    -24
          BX0    -X7*X0
          SX7    A0
          SB7    B4
          LX7    30
          BX0    X0+X7
          TB4    0,TCNT
          WE     B4
          PER    /ECS/PIOX   PROCESS PARITY ERROR
          SB3    B0+
          AX4    48          REPOSITION TRACK NUMBER
          SA0    X3          RESTORE CM ADDRESS
          SB4    B7
          SB7    B1+B1
 PET3     NZ     B2,PET      IF MORE TRACKS
          MX6    12
          SA2    A5+B1       FETCH *MB* PARAMETERS
          LX6    -24
          SX7    X4+4000B
          BX6    -X6*X2      CLEAR TRACK
          SB4    100B
          SA2    PAS3        CHECK PASS 3
          SB6    X2+         PASS 3 SECTOR COUNT
          LX7    24
          BX6    X6+X7       SET CURRENT TRACK
          LX2    12
          IX6    X6+X2       UPDATE CURRENT SECTOR
          SX7    PET6        SET RETURN FROM PASS 3
          SA7    PETB
          SA6    A5+1
 PET4     SB2    B1
          NZ     B6,PET      IF PASS 3 PRESENT
          SA1    A2+B1       FETCH PASS 4
          ZR     X1,/ECS/PIOX  IF NOT READ TO EOR
          BX7    X7-X7
          SA7    A1          CLEAR PASS 4 INDICATOR
          SB4    X1          SET WORD COUNT
          AX1    18
          BX4    X1
          SB6    B1          SET BLOCK COUNT FOR FINAL READ
          SX5    X1          SECTOR NUMBER FOR FINAL READ
          MX7    24
          SA1    A1+B1       FETCH FILE POSITION AFTER EOR
          SX2    B1
          LX7    -24
          BX6    -X7*X6      REMOVE CURRENT TRACK AND SECTOR
          LX2    35
          LX1    12
          BX2    X2+X1       ADD TRACK BIT
          LX5    6           SECTOR * 100B
          BX6    X6+X2       SET FILE POSITION AFTER EOR
          AX4    18          TRACK NUMBER FOR FINAL READ
          SX7    PET4        SET RETURN FROM FINAL READ
          SA7    PETB
          SA6    A6          STORE *MB* PARAMETERS
          NZ     B4,PET      IF NOT EMPTY SECTOR
          BX1    X1-X1       RETURN STATUS = NO ERROR
          JP     /ECS/PIOX   EXIT - FUNCTION COMPLETE
 
 PET6     EQ     B5,B7,PET4  IF READ REQUEST
          LX6    -12
          MX2    -12
          BX0    X4
          AX4    10-4
          BX2    -X2*X6      EXTRACT CURRENT SECTOR
          IX0    X0+X4       ECS ADDRESS OF LINKAGE
          SX2    X2+B3
          BX7    X7-X7
          SA3    X2+TKLB     SAVE LINKAGE WORD
          SA0    B3+TKLB
          SX1    DSTE        SET *DEVICE ERROR* STATUS
          SA7    A3+         SET EOI IN LINKAGE BLOCK
          SX7    A0
          LX7    30
          BX0    X7+X0
          LX6    X3
          TB4    0,TCNT
          WE     B4
          PER    /ECS/PIOX   PROCESS PARITY ERROR
          BX1    X1-X1       RETURN STATUS = NO ERROR
          SA6    A3          RESTORE LINKAGE WORD
          JP     /ECS/PIOX   EXIT - FUNCTION COMPLETE
 
 PET7     SA5    A5          CHECK REQUEST
          R=     X1,IFLS     SET STATUS = INSUFFICIENT FL FOR LOAD
          LX5    59-38
          NG     X5,/ECS/PIOX  IF READ TO EOR
          JP     HNG         HANG PP
 
 
 PETB     BSS    1           RETURN ADDRESS
 
 PAS1     CON    0           PASS 1 SECTOR COUNT
 PAS2     CON    0           PASS 2 TRACK COUNT
 PAS3     CON    0           PASS 3 SECTOR COUNT
 PAS4     CON    0,0         PASS 4 WORD COUNT (READ TO EOR ONLY)
 RWEI     RE     B4
          PER    /ECS/PIOX   PROCESS PARITY ERROR
 
+         WE     B4
          PER    /ECS/PIOX   PROCESS PARITY ERROR
          SPACE  4,10
*         TRACK LINKAGE BUFFERS.
*
*         SPACE IS ALLOCATED FOR A MAXIMUM TRACK SIZE (200B SECTORS).
*         *CPUMLD* WILL REDUCE THE BLOCK *LWA* FOR SMALLER TRACK SIZES.
*         *TKLW* IS NOW REFERENCED BY *TKLB+TCNT*.
 
 
 TKLB     BSS    0
 .A       SET    1
 .B       DUP    200B
          VFD    12/.A,12/100B,36/0
 .A       SET    .A+1
 .B       ENDD
 
          BSS    200B        *TLKW*
          QUAL   ECS
 
          ENDBLK
          BLOCK  EEC,(EXTERNAL ECS PROCESSING ROUTINES.),ECS
          SPACE  4,10
**        ASSEMBLY CONSTANTS.
 
 
 FRWC     EQU    1           FLAG REGISTER FUNCTION WORD COUNT
 CFR      SPACE  4
**        CFR - CLEAR FLAG REGISTER BIT.
*
*         ENTRY  (B3) = CPU NUMBER TO BE RESTORED TO (A0).
*                (B4) = BIT NUMBER TO CLEAR.
*                (B6) = EXIT ADDRESS.
*
*         EXIT   (A0) = CPU NUMBER = (B3).
*
*         USES   X - 0, 2.
*                A - 0.
 
 
 CFR      SA0    ZERL        SET WORD TO WRITE TO ECS
          TX0    B4+ETLT*100B+FRET,ECLT
          TX0    X0,TCNT
          SX2    A0+
          LX2    30
          BX0    X0+X2
          WE     1           CLEAR WHO HAS BIT INTERLOCKED
          RJ     ECH         HANG ON WRITE ERROR
          SX2    B1+
          TSX0   (403B,ESM,7B)
          LX0    21
          LX2    X2,B4       POSITION FLAG BIT
          BX0    X0+X2
          RE     FRWC        CLEAR FLAG REGISTER BIT
          RJ     ECH         HANG ON HALF EXIT
          SA0    B3          RESTORE CPU NUMBER
          JP     B6          RETURN
 SFR      SPACE  4
**        SFR - SET FLAG REGISTER BIT.
*
*         ENTRY  (B3) = CPU NUMBER TO BE RESTORED TO (A0).
*                (B4) = BIT NUMBER TO SET.
*                (B6) = EXIT ADDRESS.
*
*         EXIT   (X7) = 12/0,12/7777B,36/0 IF BIT ALREADY SET.
*                (X7) = 0 IF BIT NOT PREVIOUSLY SET.
*                (A0) = CPU NUMBER = (B3).
*
*         USES   X - 0, 2, 7.
*                A - 0.
 
 
 SFR      SX2    B1
          TSX0   (400B,ESM,4B)
          LX0    21          SET FLAG REGISTER FUNCTION
          LX2    X2,B4       POSITION BIT TO SET
          BX0    X0+X2
          SA0    MMFL        ENSURE (A0) .LT. FL FOR FLAG OPERATION
          SX2    A0
          MX7    12
          LX2    30
          LX7    -12
          RE     FRWC        TEST AND SET FLAG BIT
          EQ     SFR1        IF BIT PREVIOUSLY SET
          TX0    B4+ETLT*100B+FRET,ECLT
          TX0    X0,TCNT
          SX7    B0
          BX0    X2+X0
          WE     1           WRITE INDICATION OF WHICH MACHINE HAS INTER
          RJ     ECH         HANG ON WRITE ERROR
 SFR1     SA0    B3          RESTORE CPU NUMBER
          JP     B6          RETURN
          TITLE  EXTERNAL ECS PARITY ERROR PROCESSING.
          SPACE  4,10
**        MC - INPUT REGISTER FOR ECS PARITY ERROR PROCESSING ROUTINE.
 
 
 MC       VFD    18/0L1MC
          TVFD   6/,SC
          TVFD   12/,EEM
          VFD    24/0
 ECH      SPACE  4,10
**        ECH - EXTENDED MEMORY ERROR HANG.
*
*         ENTRY IS VIA RETURN JUMP FROM THE LOWER HALF OF THE ECS
*         INSTRUCTION IN THE CASE OF A FLAG REGISTER CLEAR FUNCTION.
*         IN THE CASE OF AN WRITE ERROR REPORTING IS DONE BY *RPE*
*         WHICH THEN EXITS TO *ECH1* IF THE ERROR IS UNRECOVERED.
 
 
 ECH      PS                 ENTRY
 ECH1     SX1    ECHM        SET ERROR MESSAGE ADDRESS
          SB5    ECH2        SET *MSC* RETURN
          EQ     /MONITOR/MSC  SEND MESSAGE TO SYSTEM CONTROL POINT
 
 ECH2     EQ     *           HANG CPUMTR
 PER      SPACE  4
**        PER - PROCESS ECS PARITY ERROR.  (MONITOR MODE)
*
*         ENTRY IS VIA RETURN JUMP FROM THE LOWER HALF OF THE ECS
*         INSTRUCTION.
*
*         EXIT   RETURNS TO CALLER IF ERROR RECOVERED ON RETRY.
*                (X0) = ADDRESS OF ECS PARITY ERROR, IF UNRECOVERED.
*
*         USES   X - NONE.
*                B - NONE.
*                A - 1, 2, 6, 7.
*
*         CALLS  RPE.
 
 
 PERX     SB7    X1+         RESTORE (B7)
          SA1    A1+1        RESTORE (X1)
 PER      PS     0           ENTRY/EXIT
          SA7    PERA        SAVE REGISTERS
          BX7    X5
          SX5    B7
          SB7    PERX        *RPE* RETURN ADDRESS
          EQ     RPE
 
 PERA     BSS    9           REGISTER SAVE BUFFER
 RPE      SPACE  4
**        RPE - RECOVER AND REPORT ECS PARITY ERROR.
*         THE WORD COUNT FOR ECS READ/WRITES MUST BE EXPRESSED AS
*         A CONSTANT OR AS A CONSTANT + (B4).
*
*         ENTRY  (X5) = VALUE TO BE RESTORED TO B7.
*                (X7) = VALUE TO BE RESTORED TO X5.
*                (B7) = EXIT ADDRESS.
*                (B7)+1 = WORD RETURN JUMPED TO FROM ECS INSTRUCTION.
*                (A7) = FIRST WORD ADDRESS OF REGISTER SAVE BUFFER.
*                (X0) = ADDRESS OF ECS PARITY ERROR, IF UNRECOVERED.
*
*         EXIT   (X1) = VALUE TO BE RESTORED TO B7.
 
 
 RPE      SA6    A7+B1       SAVE REGISTERS - (X6)
          LX6    X4
          SA7    A6+B1       SAVE (X5)
          SA6    A7+B1       SAVE (X4)
          BX7    X3
          LX6    X2
          SA7    A6+B1       SAVE (X3)
          SA6    A7+B1       SAVE (X2)
          SX7    A0
          MX2    -18
          SX3    B3
          BX7    -X2*X7
          SX4    B4
          BX3    -X2*X3
          LX7    18
          BX4    -X2*X4
          BX7    X3+X7
          SX3    B6
          BX6    -X2*X5
          LX7    18
          BX3    -X2*X3
          LX6    18
          BX7    X7+X4
          SX4    B5
          SA7    A6+B1       SAVE (A0), (B3), (B4)
          BX4    -X2*X4
          BX6    X6+X3
          LX6    18
          BX6    X6+X4
          SA6    A7+B1       SAVE (B7), (B6), (B5)
          BX7    X1
          SA7    A6+B1       SAVE (X1)
          SA1    B7+B1       FIND ECS INSTRUCTION
          SB6    PERX
          AX1    30
          SA2    X1-1        READ INSTRUCTION
          AX2    30
          SX3    X2          SET CONSTANT PORTION OF WORD COUNT
          LX2    59-20       POSITION REGISTER PORTION OF WORD COUNT
          PL     X2,RPE1     IF (B4) NOT USED IN WORD COUNT
          SX3    X3+B4
 RPE1     SA1    MC
          BX1    X1+X3       MERGE WORD COUNT IN CALL
          MX6    -3
          BX6    -X6*X2      EXTRACT READ/WRITE PORTION OF INSTRUCTION
          LX6    18
          BX5    X1+X6       *1MC* CALL
          BX1    X5
          BX6    X5
          SA6    RPEA        SAVE *1MC* CALL
          SB3    RPE2        *APS* RETURN ADDRESS
          NE     B6,B7,/PROGRAM/APS  IF IN PROGRAM MODE
          SX7    B7          SAVE (B7)
          SB3    RPE1.1      *CAL* *ACB* RETURN ADDRESS
          BX1    X1-X1       PRESET NO BUFFER AVAILABLE
          SA7    /MONITOR/T1
          SB6    /MONITOR/ACB  *CAL* RETURN ADDRESS
          TB7    SCA         SET SYSTEM CONTROL POINT ADDRESS
          EQ     /MONITOR/CAL  CHECK ACTIVITY LIMIT
 
 RPE1.1   ZR     X1,RPE1.3   IF NO BUFFER AVAILABLE
          SB3    RPE1.2      *APQ* RETURN ADDRESS
          BX7    X1
          BX6    X5          *1MC* CALL
          SA7    /MONITOR/APQA  PARAMETER WORD
          SB4    B0          SET LIBRARY SEARCH NEEDED
          EQ     /MONITOR/APQ  ASSIGN PP
 
 RPE1.2   SA1    /MONITOR/APQA  GET BUFFER ADDRESS
 RPE1.3   SA2    /MONITOR/T1  RESTORE (B7)
          SB7    X2+         RESTORE (B7)
 RPE2     SA2    RPEA        *1MC* PP CALL
          SB5    X2          WORD COUNT
          LX2    -2
          BX5    X0
          SB4    X2          READ/WRITE FLAG
          SB3    B0+         SET NO ERRORS REPORTED
          ZR     X1,RPE6     IF NO BUFFER ASSIGNED
          SX6    B0+         INITIALIZE BUFFER
          SA6    X1+4
          SA6    X1+7
          SA6    X1+1
 
*         RETRY WITH SINGLE WORD TRANSFERS.
 
 RPE6     LX0    30          READ DATA
          ERX2   X0
          SX3    501B        SET UNRECOVERED WITH GOOD DATA PRESENT
          LX0    30
          BX6    X2          POSSIBLE BAD DATA (READ OPERATION)
*                            GOOD DATA (WRITE OPERATION)
          NG     B4,RPE8     IF WRITE
          SX3    601B        SET UNRECOVERED WITH BAD DATA PRESENT
          RE     1
          EQ     RPE7        IF ERROR
          LX0    30
          ERX2   X0          VERIFY DATA
          LX0    30
          BX7    X2-X6
          SX3    301B        RECOVERED WITH GOOD AND BAD DATA
          CX7    X7
          ZR     X7,RPE9     IF DATA VERIFIES
 RPE7     GT     B3,B1,RPE9  IF TWO ERRORS REPORTED
          LX3    -18
          SB3    B3+B1       INCREMENT ERRORS REPORTED
          ZR     X1,RPE9     IF NO BUFFER ASSIGNED
          LX3    -18
          MX4    -24
          LX0    30
          BX7    -X4*X0      CM ADDRESS OF TRANSFER
          LX0    30
          BX4    -X4*X0      ECS ADDRESS OF TRANSFER
          LX7    24
          BX3    X3+X4
          BX7    X7+X3
          SA7    A6          STATUS WORD
          SA6    A7+B1       BAD DATA
          BX7    X2
          BX6    X6-X6
          SA7    A6+B1       GOOD DATA
          SA6    A7+B1
          EQ     RPE9        CONTINUE ONE-WORD TRANSFER
 
 RPE8     WE     1
          EQ     RPE7
 RPE9     SA0    A0+B1       INCREMENT ADDRESSES
          SX3    B1
          SB5    B5-B1
          IX0    X0+X3
          LX3    30
          IX0    X0+X3
          GT     B5,B0,RPE6  IF MORE WORDS TO CHECK
          ZR     X1,RPE9.2   IF NO BUFFER ASSIGNED
          NZ     B3,RPE9.1   IF NOT ALL ERRORS RECOVERED
          MX0    -24
          BX7    -X0*X5      ECS ADDRESS
          SX3    B1          RECOVERED WITH NO GOOD OR BAD DATA
          LX5    -30
          LX3    -18
          BX0    -X0*X5      CM ADDRESS
          BX6    X3+X7
          LX0    24
          LX5    30
          BX6    X6+X0
          SA6    A6+         STATUS WORD
 RPE9.1   SA1    X1          SET BUFFER FULL FLAG
          MX6    1
          BX6    X1+X6
          SA6    A1
 RPE9.2   ZR     B3,RPE12    IF ERROR RECOVERED
 
*         SET UNRECOVERED ERROR EXIT ADDRESS.
 
          SA1    TPER-1
          MX4    18
          SA2    B7+1
          LX4    -12
          SB5    RPE12       *MSC* RETURN ADDRESS
 RPE10    SA1    A1+B1
          BX6    X1-X2
          BX7    X4*X6
          LX1    30
          NZ     X7,RPE10    IF EXIT ADDRESS NOT FOUND
          BX7    X6-X1
          SA7    A2          STORE JUMP TO EXIT ADDRESS
          SX1    ECEM
          JP     /MONITOR/MSC  SET *EXTENDED MEMORY ERROR.* MESSAGE
 
*         RESTORE REGISTERS.
 
 RPE12    SA1    B7+4
          SA2    A1+B1
          BX0    X5          RESTORE (X0)
          BX7    X1          RESTORE (X7)
          LX6    X2          RESTORE (X6)
          SA1    A2+B1       RESTORE (X5)
          SA2    A1+B1       RESTORE (X4)
          BX5    X1
          SA1    A2+B1       RESTORE (X3)
          LX4    X2
          BX3    X1
          SA2    A1+B1       RESTORE (X2)
          SA1    A2+B1
          SB4    X1          RESTORE (B4)
          AX1    18
          SB3    X1          RESTORE (B3)
          AX1    18
          SA0    X1          RESTORE (A0)
          SA1    A1+B1
          SB5    X1          RESTORE (B5)
          AX1    18
          SB6    X1          RESTORE (B6)
          AX1    18
          JP     B7
 
 RPEA     BSS    1           *1MC* PP CALL WORD
 
 ECHM     CON    10H HUNG -
 ECEM     DATA   C* EXTENDED MEMORY ERROR.*
 RSE      SPACE  4,10
**        RSE - REPORT STORAGE MOVE EXTENDED MEMORY ERROR.
*
*         ENTRY  (A0) = CM ADDRESS.
*                (X0) = 30/ CM ADDRESS, 30/ ECS ADDRESS.
*                (X1) = WORD COUNT.
 
 
 RSE      PS                 ENTRY/EXIT
          SA6    RSEA        SAVE (X6)
          BX6    X0
          SA6    A6+B1       SAVE (X0)
          BX6    X2
          SA6    A6+B1       SAVE (X2)
          BX6    X3
          SA6    A6+B1       SAVE (X3)
          BX6    X4
          SA6    A6+B1       SAVE (X4)
          BX6    X5
          SA6    A6+B1       SAVE (X5)
          SX6    A0+
          SA6    A6+1        SAVE (A0)
          BX5    X1          WORD COUNT
          SA1    SMRL
          LX1    59-37
          NG     X1,RSE5     IF PREVIOUS ERROR
          SB3    RSE1        *ACB* RETURN ADDRESS
          EQ     /MONITOR/ACB  ASSIGN COMMUNICATION BUFFER
 
 RSE1     ZR     X1,RSE5     IF NO BUFFER ASSIGNED
          SB4    X5
          LX5    24
          BX6    X5+X1
          SA6    RSEB        DATA FOR *1MC* CALL
          SX6    B1
          SA2    SMRL        SET EXTENDED MEMORY ERROR DURING MOVE
          LX6    37
          BX6    X6+X2
          SA6    A2
          SB3    B0          INITIALIZE NO ERRORS
          BX6    X6-X6
          SA6    X1+B1
 RSE2     SX3    601B        UNRECOVERED WITH BAD DATA
          LX0    30
          ERX2   X0          READ BAD DATA
          LX0    30
          RE     1
          EQ     RSE6        IF ERROR
          LX0    30
          ERX4   X0          READ GOOD DATA
          LX0    30
          SX3    301B        RECOVERED WITH GOOD AND BAD DATA
          BX5    X4-X2
          CX5    X5
          NZ     X5,RSE6     IF COMPARE ERROR
 RSE3     SX3    B1
          IX0    X0+X3       INCREMENT ECS ADDRESS
          LX0    30
          IX0    X0+X3       INCREMENT CM ADDRESS
          SA0    X0+
          LX0    30
          SB4    B4-B1
          NZ     B4,RSE2     IF MORE WORDS TO CHECK
          NZ     B3,RSE4     IF ERRORS REPORTED
          SA2    RSEA+1      (X0)
          MX0    -24
          BX5    -X0*X2      ECS ADDRESS
          SX3    B1          RECOVERED - NO GOOD OR BAD DATA
          LX2    -30
          LX3    -18
          BX0    -X0*X2      CM ADDRESS
          BX6    X3+X5
          LX0    24
          BX6    X6+X0
          SA6    A6          SET STATUS WORD IN BUFFER
 RSE4     SA1    X1          SET BUFFER COMPLETE
          MX6    1
          BX6    X6+X1
          SA6    A1
 RSE5     SA1    RSEA        RESTORE REGISTERS
          BX6    X1          RESTORE (X6)
          SA1    A1+B1
          BX0    X1          RESTORE (X0)
          SA2    A1+B1       RESTORE (X2)
          SA3    A2+B1       RESTORE (X3)
          SA4    A3+B1       RESTORE (X4)
          SA1    A4+B1
          BX5    X1          RESTORE (X5)
          SA1    A1+B1
          SA0    X1          RESTORE (A0)
          EQ     RSE         RETURN
 
 RSE6     GT     B3,B1,RSE3  IF TWO ERRORS REPORTED
          SB3    B3+B1
          MX6    -24
          BX7    -X6*X0      ECS ADDRESS
          LX0    30
          BX6    -X6*X0      CM ADDRESS
          LX0    30
          LX3    -18
          LX6    24
          BX7    X7+X3
          BX6    X6+X7
          SA6    A6          STATUS WORD
          BX6    X2          BAD DATA
          BX7    X4          GOOD DATA
          SA6    A6+B1
          SA7    A6+B1
          BX6    X6-X6
          SA6    A7+B1
          EQ     RSE3        PROCESS NEXT WORD
 
 
 RSEA     BSS    7           REGISTER SAVE AREA
 RSEB     BSS    1           *1MC* CALL DATA
 TSM      SPACE  4,10
**        TSM - EXTENSION FOR EXTERNAL ECS PARITY ERROR PROCESSING
*         DURING STORAGE MOVE.
*
*         EXIT   (X4) = RESTORED TO (SMRL) SHIFTED IF ENTRY AT *TSM4*.
*                TO */MONITOR/BNJ1* IF ENTRY AT *TSM8*.
*                TO */MONITOR/TSM1* IF ENTRY AT *TSM4*.
*
*         USES   X - 1, 2, 4, 6, 7.
*                A - 1, 2, 4, 6, 7.
*                B - 3, 4, 6.
*
*         CALLS  /MONITOR/APQ,/MONITOR/CAL.
 
 
 TSM4     SA2    RSEB        GET ERROR DATA
          SA1    MC
          SB4    B0          SET LIBRARY SEARCH NEEDED
          BX7    X2
          SA7    /MONITOR/APQA  PARAMETER WORD (BUFFER ADDRESS)
          AX2    24
          BX6    X1+X2
          SB6    TSM5        *CAL* RETURN ADDRESS - NO LIMIT
          SB3    TSM6        *CAL* RETURN ADDRESS - IF LIMIT
          EQ     /MONITOR/CAL  CHECK ACTIVITY LIMIT
 
 TSM5     SB3    TSM7        *APQ* RETURN ADDRESS
          EQ     /MONITOR/APQ  ASSIGN PP
 
 TSM6     SA1    /MONITOR/APQA  CLEAR BUFFER INTERLOCK
          BX6    X6-X6
          SA6    X1
 TSM7     SA4    SMRL        RESTORE (X4)
          NO
          LX4    59-37
          EQ     /MONITOR/TSM2  RE-ENTER MAIN PROCESSING
 
*         ERROR OCCURED DURING STORAGE MOVE OF USER ECS.
*         JOB MUST NOT BE RESTARTED, AND *MTR* WILL SET AN
*         ERROR FLAG ON THE JOB AND ABORT IT.
 
 TSM8     SX6    B1          SET XM ERROR RESPONSE
          LX6    36
          SA6    SMRL        SET RESPONSE
          EQ     /MONITOR/BNJ1  BEGIN NEW JOB
          TITLE  EXTERNAL ECS PROGRAM MODE ROUTINES.
          QUAL   PROGRAM
 MSE      SPACE  4
**        MSE - MOVE STORAGE THROUGH ECS.
*
*         ENTRY  (B7) = CP/PCP ADDRESS.
*
*         EXIT   TO *MST2* TO UPDATE REFERENCE ADDRESS.
*
*         USES   X - 0, 1, 3, 4, 5, 6, 7.
*                B - 2, 3, 4, 5.
*                A - 1, 5, 6, 7.
 
 
 MSE      TA1    EEN         CHECK ECS STATUS
          SB4    BTRI
          LX1    59-49
          NO
          NG     X1,MST      IF EXTENDED MEMORY OFF OR DOWN
          SB6    MSE1        SET *SFR* RETURN
          TNO    /ECS/SFR,MMF  SET *BTRI* INTERLOCK
 
 MSE1     NZ     X7,MST      IF UNABLE TO INTERLOCK FLAG REGISTER
          SA5    SMIN
          SA2    B7+FLSW     GET FL STATUS WORD
          MX1    -12
          BX4    -X1*X2
          LX5    6
          LX2    -12
          NO
          LX4    6           FL
          BX3    -X1*X2
          LX2    12+12
          LX3    6           RA
          BX2    -X1*X2
          LX2    6           NFL
          SB5    X5+         SET MOVE INCREMENT
          IX3    X3-X2       SUBTRACT NFL SIZE FROM RA
          TX0    SMLT*100B,ECLT
          TX0    X0,TCNT
          IX4    X4+X2       ADD NFL SIZE TO FIELD LENGTH
          MX6    30
          SB4    X4
          LX5    30
          SB6    30
          SX2    100B
          NG     X5,MSE3     IF DOWNWARD MOVE
          IX3    X3+X4
          IX3    X3-X2
          BX2    -X2
          SA0    X3
          LX4    X3,B6
          BX0    X4+X0
 
*         MOVE 100B WORDS THROUGH ECS.
 
 MSE2     WE     100B        WRITE 100B WORDS
          EQ     MSE4        IF EXTENDED MEMORY ERROR
          SA0    A0+B5       SET ADDRESS PLUS INCREMENT
          IX0    X0+X5
          RE     100B
          EQ     MSE4        IF EXTENDED MEMORY ERROR
          IX3    X3+X2
          SB4    B4-100B     DECREMENT WORD COUNT
 MSE3     LX4    X3,B6
          BX0    -X6*X0
          BX0    X4+X0
          SA0    X3
          NZ     B4,MSE2     IF NOT END OF MOVE
          SB4    BTRI        SET FLAG BIT TO CLEAR
          SB6    MST2        SET *CFR* RETURN
          TEQ    (/ECS/CFR,MMF,/PROGRAM/MST2)
 
*         COMPLETE MOVE WITHOUT ECS.
 
 MSE4     SX4    B1+
          LX5    30          MOVE DIFFERENTIAL
          IX1    X3-X4
          SX6    MST         DISABLE STORAGE MOVE THROUGH ECS
          SA6    TMNR+MSTF
          NG     X5,MSE6     IF DOWNWARD MOVE
          BX4    -X4
          IX1    X1-X2
 MSE6     IX1    X1+X4
          ERX2   X1
          SB4    B4-B1
          IX7    X1+X5
          BX6    X2
          EWX6   X7
          NZ     B4,MSE6     IF MOVE NOT COMPLETE
          SX1    100B        WORD COUNT
          RJ     /ECS/RSE    REPORT STORAGE MOVE EXTENDED MEMORY ERROR
          SB5    MST2        *MSC* RETURN ADDRESS
          SX1    MSEA        * EXTENDED MEMORY ERROR - STORAGE MOVE.*
          EQ     /MONITOR/MSC  ISSUE ERROR MESSAGE
 
 
 MSEA     DATA   C* EXTENDED MEMORY ERROR - STORAGE MOVE.*
 PER      SPACE  4
**        PER - PROCESS ECS PARITY ERROR.  (PROGRAM MODE)
*
*         ENTRY IS VIA RETURN JUMP FROM THE LOWER HALF OF THE ECS
*         INSTRUCTION.
*
*         EXIT   RETURNS TO CALLER IF ERROR RECOVERED ON RETRY.
*
*         USES   X - NONE.
*                B - NONE.
*                A - 1, 2, 6, 7.
*
*         CALLS  RPE.
 
 
 PERX     SB7    X1+         RESTORE (B7)
          SA1    A1+1        RESTORE (X1)
 
 PER      PS     0           ENTRY/EXIT
          SA7    PERA        SAVE REGISTERS
          BX7    X5
          SX5    B7
          SB7    PERX        *RPE* RETURN ADDRESS
          EQ     /ECS/RPE
 
 PERA     BSS    9           REGISTER SAVE BUFFER
          TITLE  ECS PARITY ERROR PROCESSING PARAMETERS.
          QUAL   ECS
 TPER     SPACE  4
**        TPER - TABLE OF PROCESSORS FOR UNRECOVERED ERRORS.
*         ENTRY  1 WORD.
*
*T        12/,18/  ADD,12/,18/  EXIT
*         ADD    ADDRESS + 1 OF ECS INSTRUCTION.
*         EXIT   UNRECOVERED ERROR EXIT ADDRESS.
 
 
 TPER     BSS    0
 
 TPER     HERE
 
          CON    0
 
          ENDBLK
          BLOCK  SUE,(SIMULTANEOUS UEM/ESM.)
          SPACE  4,10
 CME$     EQU    1           DEFINE CME INSTRUCTION BLOCK
 RUM      SPACE  4,10
**        RUM - READ USER ECS DATA FROM UEM TO CM.
*
*         ENTRY  AT *RUM* IF PROGRAM MODE.
*                AT *RUM1* IF MONITOR MODE.
*                (B4) = WORD COUNT TO TRANSFER.
*                (B6) = RETURN ADDRESS FOR *RUE* MACRO, OR
*                COMPLEMENT OF RETURN ADDRESS FOR *WUE* MACRO.
*                (X0) = 30/ ABSOLUTE CM ADDRESS, 30/ UEM ADDRESS.
*
*         EXIT   X0, X1, X2, X3, X4, X6, X7, B4, B5, B6 RESTORED.
*
*         USES   A - 2, 3, 6, 7.
*                B - 4, 5, 6.
*                X - 0, 1, 2, 3, 4, 6, 7.
*
*         CALLS  /CME/PSM.
 
 
 RUM      SA7    PMRG+4      SAVE PROGRAM MODE REGISTERS
          EQ     RUM2        SAVE REGISTERS
 
 RUM1     SA7    MMRG+4      SAVE MONITOR MODE REGISTERS
 
*         SAVE X0, X1, X4, X6, X7, B4, B5, B6, X2, X3
*         IN PROGRAM OR MONITOR MODE BUFFER.
 
 RUM2     SA6    A7-B1
          SX7    B4
          BX6    X4
          SA7    A7+B1
          SA6    A6-B1
          SX7    B5
          LX6    X1
          SA7    A7+B1
          MX4    -12
          SX7    B6
          SA7    A7+B1
          SA6    A6-B1
          BX7    X2
          SA2    UEML        GET UEM BASE ADDRESS
          BX6    X0
          LX2    12
          SA7    A7+B1
          LX7    X3
          BX2    -X4*X2
          SA6    A6-B1
          LX2    9
          SA7    A7+B1
          IX0    X0+X2       ABSOLUTIZE UEM ADDRESS
          PL     B6,RUM3     IF TRANSFER DATA FROM UEM TO CM
          LX0    30          TRANSFER DATA FROM CM TO UEM
          SB6    -B6
          SX7    B6+         SAVE RETURN ADDRESS
          SA7    A7-2
 RUM3     MX2    30
          BX1    X2*X0       ADDRESS TO TRANSFER TO
          SB6    RUM7        SET RETURN ADDRESS
          BX0    -X2*X0      ADDRESS TO TRANSFER FROM
          SB5    RUM4        SET RETURN ADDRESS
          LX1    30
          IX1    X0-X1
          EQ     /CME/PSM    PRESET TRANSFER
 
*         TRANSFER 10B WORD BLOCKS THROUGH REGISTERS.
 
 RUM4     ERX2   X0
          IX0    X0+X4
          ERX3   X0
          IX0    X0+X4
          ERX6   X0
          IX0    X0+X4
          ERX7   X0
          IX0    X0+X4
          EQ     B4,B1,RUM6  IF ONLY ONE BLOCK TO TRANSFER
 RUM5     EWX2   X1
          IX1    X1+X4
          ERX2   X0
          IX0    X0+X4
          SB4    B4-1
          EWX3   X1
          IX1    X1+X4
          ERX3   X0
          IX0    X0+X4
          EWX6   X1
          IX1    X1+X4
          ERX6   X0
          IX0    X0+X4
          EWX7   X1
          IX1    X1+X4
          ERX7   X0
          IX0    X0+X4
          EWX2   X1
          IX1    X1+X4
          ERX2   X0
          IX0    X0+X4
          EWX3   X1
          IX1    X1+X4
          ERX3   X0
          IX0    X0+X4
          EWX6   X1
          IX1    X1+X4
          ERX6   X0
          IX0    X0+X4
          EWX7   X1
          IX1    X1+X4
          ERX7   X0
          IX0    X0+X4
          GT     B4,B1,RUM5  IF MORE 10B WORD BLOCKS TO TRANSFER
 RUM6     EWX2   X1
          IX1    X1+X4
          ERX2   X0
          IX0    X0+X4
          EWX3   X1
          IX1    X1+X4
          ERX3   X0
          IX0    X0+X4
          EWX6   X1
          IX1    X1+X4
          ERX6   X0
          IX0    X0+X4
          EWX7   X1
          IX1    X1+X4
          ERX7   X0
          EWX2   X1
          IX1    X1+X4
          EWX3   X1
          IX1    X1+X4
          EWX6   X1
          IX1    X1+X4
          EWX7   X1
 
*         RESTORE REGISTERS.
 
 RUM7     SA2    A6
          SA3    A6+B1
          BX0    X2
          LX1    X3
          SA2    A3+B1
          SA3    A2+B1
          BX4    X2
          LX6    X3
          SA2    A3+B1
          SA3    A2+B1
          BX7    X2
          SB4    X3
          SA2    A3+B1
          SA3    A2+B1
          SB5    X2
          SB6    X3
          SA2    A3+B1
          SA3    A2+B1
          JP     B6          RETURN
 WUM      SPACE  4,10
**        WUM - WRITE USER ECS DATA FROM CM TO UEM.
*
*         ENTRY  AT *WUM* IF PROGRAM MODE.
*                AT *WUM1* IF MONITOR MODE.
*                (B4) = WORD COUNT TO TRANSFER.
*                (B6) = RETURN ADDRESS.
*                (X0) = 30/ ABSOLUTE CM ADDRESS, 30/ UEM ADDRESS.
*
*         EXIT   TO *RUM* IF PROGRAM MODE.
*                TO *RUM1* IF MONITOR MODE.
 
 
 WUM      SB6    -B6         INDICATE TRANSFER FROM CM TO UEM
          EQ     RUM         TRANSFER DATA FOR PROGRAM MODE
 
 WUM1     SB6    -B6         INDICATE TRANSFER FROM CM TO UEM
          EQ     RUM1        TRANSFER DATA FOR MONITOR MODE
          SPACE  4,10
 MMRG     BSS    10          MONITOR MODE X0,X1,X4,X6,X7,B4,B5,B6,X2,X3
 
 PMRG     BSS    10          PROGRAM MODE X0,X1,X4,X6,X7,B4,B5,B6,X2,X3
 
          ENDBLK
          BLOCK  ECSBUF,(ECS BUFFER SPACE.),PROGRAM
          SPACE  4
 PBUF     BSS    21B         PROGRAM MODE BUFFER
 
          ENDBLK
          BLOCK  MMFBUF,(MMF BUFFER SPACE.),PROGRAM
 
*         THIS BUFFER IS SHARED BY MMF AND USER ECS SUBROUTINES.
*         THE BUFFER WILL BE ALLOCATED IF EITHER MMF OR USER ECS IS
*         DEFINED OR IF BOTH ARE DEFINED.
          SPACE  4
          BSS    MECB-21B
 
          ENDBLK
          BLOCK  EXPACS,(EXCHANGE PACKAGES.),MONITOR
 .EXPACS  BSS    0           FWA OF BLOCK
 MXP      SPACE  4
**        MXP - PPU MONITOR EXCHANGE PACKAGE.
 
 
 MXP      EXP    P=PMN,FL=(,MCM),RAX=(,RXX),FLX=(,MEC),B1=1,B2=MXP,EM=(,
,XPFE)
 BXP      SPACE  4,10
**        BXP - BREAKPOINT EXCHANGE PACKAGE.
 
 
 BXP      BSS    /CPB/CPBAL  REGISTERS / BREAKPOINT DATA
          ORG    BXP+/CPB/CPBA
          VFD    60/0        CLEAR PREVIOUS BREAKPOINT ADDRESS
 +        RJ     /CPB/BKP    BREAKPOINT PROTOTYPE
 -        VFD    30/0
          ORG    BXP+/CPB/CPBAL
 IXP      SPACE  4,10
**        IXP - IDLE EXCHANGE PACKAGE.
 
 
 IXP      EXP    P=2,RA=/PROGRAM/IDL,FL=5,MA=IXP,EM=EEMC,EA=IXP,X1=77B
 
*         *STSW*.
 
          VFD    3/ACPS      *A* CPU STATUS
          VFD    57/0
 
*         *CWQW*.
 
          VFD    2/1
          VFD    7/IDCS      CPU PRIORITY
          VFD    1/0
          VFD    1/1         CPU SLICE ACTIVE
          VFD    1/0         RECALL FLAG
          VFD    1/1         EXTENDED CPU SLICE INCOMPLETE
          VFD    2/0
          VFD    9/0         SERVICE CYCLE
          VFD    9/SSSC*JCBE  SERVICE PARAMETERS INDEX
          VFD    1/0         *MTR* BYPASS FLAG
          VFD    2/1         SELECT CPU 0
          VFD    3/0
          VFD    3/MIXT      MAIN IDLE PACKAGE EXCHANGE PACKAGE TYPE
          VFD    18/0        *WQ* LINKAGE
 
*         *CSAW*.
 
          VFD    60/0
 
*         *CTMW*.
 
          VFD    60/0
          SPACE  4
**        PXP - PPU EXCHANGE PACKAGES.
*         COPIED ONCE FOR EACH PPU EXCEPT 0 AND 1.
*         (A5) = PPU OUTPUT REGISTER ADDRESS.
 
 
 PXP      EXP    P=PPR,FL=(,MCM),RAX=(,RXX),FLX=(,MEC),B1=1,B2=PXP,A5=(2
,1B,FP),EM=(,XPFE)
 
          VFD    60/10RPPU EXPACK
 
 
          ERRNZ  MXP-.EXPACS-/EXPACS/MXP  *COMSMSC* MUST BE CHANGED
          ERRNZ  BXP-.EXPACS-/EXPACS/BXP  *COMSMSC* MUST BE CHANGED
          ERRNZ  IXP-.EXPACS-/EXPACS/IXP  *COMSMSC* MUST BE CHANGED
          ERRNZ  PXP-.EXPACS-/EXPACS/PXP  *COMSMSC* MUST BE CHANGED
 LBAT     SPACE  4,10
**        LBAT - LOADED *CPUMTR* BLOCK ADDRESS TABLE.
*
*         ONE ENTRY FOR EACH BLOCK LOADED.  SPACE IS ALLOCATED FOR THE
*         MAXIMUM POSSIBLE NUMBER OF BLOCKS.
*
*T W0     VFD    42/ 0,18/ FWA      *CPUMTR* MAIN BLOCK
*T WN     VFD    42/ NAME,18/ FWA   ADDITIONAL ENTRIES
*T        VFD    60/ 0              END OF TABLE
*
*         NAME   NAME OF BLOCK LOADED.
*         FWA    ABSOLUTE CM ADDRESS OF BLOCK.
 
 
 LBAT     BSS    /DSL/CPBL
          SPACE  4,10
 
          ENDBLK
          BLOCK  XP176,(CYBER 176 EXCHANGE PACKAGES.),MONITOR
 MCU      SPACE  4
**        MCU - DEAD START EXCHANGE PACKAGE.
 
 
 MCU      EXP    P=CXJ,FL=(,MCM),EM=EEMC+20B,MA=IXP
 CXP      SPACE  4
**        CXP - CLOCK EXCHANGE PACKAGE.
 
 
 CXP      EXP    P=CXJ,FL=(,MCM),FLX=(,MEC),B1=1,B2=CXP,EM=(,EXPFEB),X0=
,400000B,MA=CXP
 EEA      SPACE  4
**        EEA - ERROR EXIT EXCHANGE PACKAGE.
 
 
 EEA      EXP    P=EXP+1,B1=1,FL=(,MCM),B2=EEA,EM=(,EXPFEB),MA=EEA,EA=40
,0000B,X0=77770000777777777777B,X4=1
          SPACE  4,10
          BSS    20B
 
          ENDBLK
          BLOCK  XP819,(CYBER 176/FLPP INTERRUPT PACKAGES.),IH819
 XP819    SPACE  4,10
 MCU      EQU    /MONITOR/MCU
 XP819    SPACE  4,10
**        CHANNEL 2 INPUT PACKAGE.
 
 
 C2I      EXP    P=IOA,FL=(,MCM),EM=(,EXPFEB),FLX=(,MEC),B1=1,MA=C2I,A0=
,(MCU+400B),A1=C3I,B2=3,B4=2
          SPACE  4,10
**        CHANNEL 2 OUTPUT PACKAGE.
 
 
 C2O      EXP    P=WRT1,FL=(,MCM),EM=(,EXPFEB),FLX=(,MEC),B1=1,MA=C2O,A0
,=(MCU+400B),A1=C3O,B2=3,B4=2
          SPACE  4,10
**        CHANNEL 3 INPUT PACKAGE.
 
 
 C3I      EXP    P=IOL,FL=(,MCM),EM=(,EXPFEB),FLX=(,MEC),B1=1,MA=C3I,A0=
,(MCU+400B),A1=C2I,B2=2,B4=3
          SPACE  4,10
**        CHANNEL 3 OUTPUT PACKAGE.
 
 
 C3O      EXP    P=WRT1,FL=(,MCM),EM=(,EXPFEB),FLX=(,MEC),B1=1,MA=C3O,A0
,=(MCU+400B),A1=C2O,B2=2,B4=3
          SPACE  4,10
**        CHANNEL 4 INPUT PACKAGE.
 
 
 C4I      EXP    P=IOA,FL=(,MCM),EM=(,EXPFEB),FLX=(,MEC),B1=1,MA=C4I,A0=
,(MCU+1000B),A1=C5I,B2=5,B4=4
          SPACE  4,10
**        CHANNEL 4 OUTPUT PACKAGE.
 
 
 C4O      EXP    P=WRT1,FL=(,MCM),EM=(,EXPFEB),FLX=(,MEC),B1=1,MA=C4O,A0
,=(MCU+1000B),A1=C5O,B2=5,B4=4
          SPACE  4,10
**        CHANNEL 5 INPUT PACKAGE.
 
 
 C5I      EXP    P=IOL,FL=(,MCM),EM=(,EXPFEB),FLX=(,MEC),B1=1,MA=C5I,A0=
,(MCU+1000B),A1=C4I,B2=4,B4=5
          SPACE  4,10
**        CHANNEL 5 OUTPUT PACKAGE.
 
 
 C5O      EXP    P=WRT1,FL=(,MCM),EM=(,EXPFEB),FLX=(,MEC),B1=1,MA=C5O,A0
,=(MCU+1000B),A1=C4O,B2=4,B4=5
          SPACE  4,10
**        CHANNEL 6 INPUT PACKAGE.
 
 
 C6I      EXP    P=IOA,FL=(,MCM),EM=(,EXPFEB),FLX=(,MEC),B1=1,MA=C6I,A0=
,(MCU+1400B),A1=C7I,B2=7,B4=6
          SPACE  4,10
**        CHANNEL 6 OUTPUT PACKAGE.
 
 
 C6O      EXP    P=WRT1,FL=(,MCM),EM=(,EXPFEB),FLX=(,MEC),B1=1,MA=C6O,A0
,=(MCU+1400B),A1=C7O,B2=7,B4=6
          SPACE  4,10
**        CHANNEL 7 INPUT PACKAGE.
 
 
 C7I      EXP    P=IOL,FL=(,MCM),EM=(,EXPFEB),FLX=(,MEC),B1=1,MA=C7I,A0=
,(MCU+1400B),A1=C6I,B2=6,B4=7
          SPACE  4,10
**        CHANNEL 7 OUTPUT PACKAGE.
 
 
 C7O      EXP    P=WRT1,FL=(,MCM),EM=(,EXPFEB),FLX=(,MEC),B1=1,MA=C7O,A0
,=(MCU+1400B),A1=C6O,B2=6,B4=7
 
          ENDBLK
          BLOCK  PRESET,(PRESET.)
 
 PRSB     EQU    *           DEFINE BEGINNING OF *PRESET* BLOCK
 
*CALL     COMSMST
          QUAL               DEFINE SYMBOLS USED GLOBALLY
 LPTU     EQU    /PRESET/LPTU
          QUAL   *
*CALL     COMS1DS
 PRS      SPACE  4
**        PRS - PRESET MONITOR.
*
*         PRESET IS OVERLAYED BY PPU EXCHANGE PACKAGES.
*
*         ENTRY  (X4) = MACHINE CM FL.
*                (X5) = MACHINE ECS FL.
*                (EFRL) = 30/,6/  LS,12/,12/  LT.
*                       LS = 40, IF TO INITIALIZE LINK DEVICE.
*                       LS = 20, IF TO PRESET LINK DEVICE.
*                       LT = LABEL TRACK OF LINK DEVICE.
*
*         EXIT   (0) = RUNNING LENGTH OF CPUMTR.
*                (ACPL) = EXCHANGE ADDRESS FOR CPU 0.
*                (ACPL+1) = EXCHANGE ADDRESS FOR CPU 1.
 
 
 PRS      SB1    1           (B1) = 1
          RJ     DBL         DETERMINE BLOCKS LOADED
          RJ     SSP         SET SYSTEM PARAMETERS
          RJ     SAC         SET ADDRESS CONSTANTS
          RJ     SDT         SET DATE AND TIME
 
*         COPY SYSTEM EXCHANGE PACKAGE TO CP AREA.
 
          SB2    17B
          TB3    SCA
 PRS1     SA1    SXP+B2
          BX6    X1
          SA6    B3+B2
          SB2    B2-1
          PL     B2,PRS1
          RJ     CIR         CLEAR INTERLOCKS
          RJ     SCM         SET CPU MULTIPLIERS
          RJ     SJB         SETUP JOB CONTROL BLOCKS
          RJ     SCS         SET CPU STATUS
          RJ     CLE         CLEAR EXTENDED MEMORY
          RJ     IBO         INITIALIZE BUFFERED I/O
          RJ     SCD         SET CHANNEL DATA
          RJ     SDT         SET DATE AND TIME AGAIN
 
*         INITIALIZE OPTICAL DISK SCANNER TIMER.
 
          SA1    OSTP        READ *OSTP*
          MX2    48
          BX6    X2*X1       CLEAR SCAN INTERVAL COUNTER
          SX2    63          SET LONG TIMER AT DEAD START
          IX6    X6+X2
          SA6    A1          REWRITE *OSTP*
 
*         CLEAR SYSTEM CONTROL POINT MESSAGES.
 
          SX6    B0+
          TA6    SNSW,SCA
          TA6    MS2W,SCA
 
*         TERMINATE CPU WAIT AND RECALL QUEUES.
 
          SX6    /MONITOR/WT  TERMINATE *WQ*
          SA6    WQRL
          SX6    PTMF        BUILD RECALL ENTRY
          MX2    36
          LX6    -12
          LX2    -12
          BX0    X2+X6
          SX6    3REND       PP NAME
          SB3    PRSX        SET *AQR* RETURN ADDRESS
          LX6    -18
          R=     X2,/MONITOR/RQ  SET QUEUE TYPE
          TB7    SCA         SET SYSTEM CONTROL POINT
          EQ     /MONITOR/AQR  ASSIGN QUEUE REQUEST
          SPACE  4
**        SXP - SYSTEM JOB EXCHANGE PACKAGE.  (PROGRAM MODE MONITOR)
*         COPIED TO SYSTEM CONTROL POINT.
 
 
 SXP      EXP    P=/PROGRAM/PRG,FL=(,MCM),RAX=(,RXX),FLX=(,MECPRG),MA=(,
,SCA),B1=1,EM=(,PXPFE),EA=(,SCA)
          TITLE  PRESET SUBROUTINES.
 SAC      SPACE  4,10
**        SAC - SET ADDRESS CONSTANTS.
 
 
 SAC      PS                 ENTRY/EXIT
          MX0    -6
          SA5    REL         FIRST ENTRY
          MX4    1
 SAC1     SA1    X5          READ DATA WORD
          LX5    6           SET POSITION
          BX2    -X0*X5
          LX5    6           SET FIELD WIDTH
          BX3    -X0*X5
          LX5    18          SET RELOCATION VALUE ADDRESS
          SB3    X3
          SA3    X5          READ RELOCATION VALUE
          UX5,B5 X5          GET NUMBER OF CONDITIONS
          SB4    B3-B1       GENERATE MASK
          SB2    X2          SET MASK SHIFT COUNT
          AX6    X4,B4
          SB3    B2-B3
          LX6    X6,B2       POSITION MASK
          AX5    48
          BX7    X6*X1       EXTRACT ORIGINAL FIELD
          BX2    X3-X5
          SA5    A5+B1       READ NEXT WORD
          ZR     B5,SAC4     IF NO CONDITIONAL VALUE SETTING
          BX2    X5
          BX7    X7-X7       CLEAR ORIGINAL VALUE
          EQ     B5,B1,SAC3  IF THIS IS THE LAST CONDITION
 SAC2     NZ     X3,SAC3     IF THE CONDITION IS MET
          SA5    A5+B1       GET THE NEXT CONDITION
          SB5    B5-B1
          SA3    X5+
          GT     B5,B1,SAC2  IF NOT THE LAST CONDITION
 SAC3     ZR     X3,SAC4     IF CONDITION NOT MET
          AX5    30
          BX2    X5
 SAC4     SA5    A5+B5       GET FIRST WORD OF NEXT ENTRY
          LX3    X2,B3       SHIFT VALUE
          BX1    -X6*X1      CLEAR FIELD
          BX2    -X6+X3
          IX3    X7+X2       RELOCATE FIELD
          BX2    X6*X3
          BX7    X1+X2       STORE RELOCATED WORD
          SA7    A1
 
*         CHECK IF THIS BLOCK WAS LOADED BY CPUMLD.
 
 SAC5     NZ     X5,SAC1     IF NOT END OF LIST
          SA5    A5+B1
          MX2    42
          ZR     X5,SAC      IF END OF BLOCK LISTS
          SA1    BLKT
 SAC6     ZR     X1,SAC7     IF BLOCK NOT LOADED
          BX3    X2*X1
          BX5    X2*X5
          SA1    A1+B1
          BX3    X5-X3
          NZ     X3,SAC6     IF NO MATCH ON BLOCK NAME
          SA5    A5+B1
          EQ     SAC5        SET ADDRESS CONSTANTS FOR THIS BLOCK
 
*         BLOCK WAS NOT LOADED - IGNORE ANY RELOCATION ADDRESSES.
 
 SAC7     SA5    A5+1
          NZ     X5,SAC7     IF NOT END OF BLOCK TABLE
          EQ     SAC5        PROCESS NEXT BLOCK TABLE
 
 
*         RELOCATION VALUES.
 
 OB       VFD    42/0,18/ORG
 CX       VFD    42/0,18/CL+CACX
 ACAD     CON    2           ADJUSTMENT FOR ACCOUNTING OVERHEAD
 ACAD2    CON    1           ACAD/2
 CMCF     CON    0           CENTRAL MEMORY COPY FLAG
 DCPC     CON    0           DUAL CPU MACHINE WITH CACHE
 DP       CON    0           DAYFILE POINTERS FWA
 DSCB     CON    0           *DSCB* ADDRESS
 ECCM     CON    0           LOCATION OF ECS CLOCK FOR THIS MACHINE
 ECLT     CON    0           LOCATION OF EXTENDED MEMORY LABEL TRACK
 ECSB     CON    17000B      PP/ECS BUFFER
 ECSBL    CON    ECBL        PP ECS I/O BUFFERS LENGTH
 EEAD     CON    0           ERROR EXIT ADDRESS FOR CYBER 176
 EEN      CON    0           ECS EST ADDRESS
 EJT      CON    0           FWA EJT
 EJTM     CON    0           MAXIMUM NUMBER OF ENTRIES IN EJT
 EMS      CON    0           MST ADDRESS OF ECS EQUIPMENT
 EEM      CON    0           EXTENDED MEMORY EST ORDINAL (CPU ACCESS)
 ESM170   CON    0           170 ESM MODE FLAG
 ESM      CON    0           ESM MODE FLAG
 EST      CON    6500B       FWA EST
 ESTL     CON    100B        EST LENGTH
 EMB      CON    0           FWA OF ERROR MESSAGE BUFFER
 EVT      CON    0           FWA EVENT TABLE
 EXPA     CON    0           EXCHANGE PACKAGE ADDRESS FOR CYBER 176
 CCMB     CON    1           CLEAR CM BUFFER (0=LARGE MEMORY CYBER 990)
 FNT      CON    6600B       FWA OF FNT
 FNTLWA   CON    7600B       LWA OF FNT
 FNTM     CON    400B        MAXIMUM NUMBER OF ENTRIES IN SYSTEM FNT
 FP       CON    0           ADDRESS OF FIRST PP COMMUNICATION AREA
 FPC      CON    0           ADDRESS OF FIRST CPP COMMUNICATION AREA
 FP8      CON    0           ADDRESS OF FIRST PP COMMUNICATION AREA/8
 FPX      CON    0           ADDRESS OF FIRST EXTENDED PP COMM. BLOCK
 JCB      CON    0           FWA OF JOB CONTROL BLOCK TABLE
 MCM      CON    200000B     MACHINE FL
 MCT      CON    0           FWA OF MEMORY CONTROL TABLE
 NMCT     CON    0           NUMBER OF MCT ENTRIES
 RAE      CON    0           XM BASE ADDRESS
 RAEX     CON    0           XM BASE ADDRESS SHIFTED
 RXX      CON    0           RAE/100 IN EXPANDED MODE, ELSE RAE
 MEC      CON    1000000B    MACHINE FLX
 MCMS     CON    2000B       MACHINE FL SHIFTED
 MECS     CON    0           MACHINE FLX FLAG BIT SHIFTED
 MECNF    CON    0           MACHINE FLE / 1000B
 MECPRG   CON    57000000B   MACHINE FLX (PROGRAM MODE)
 MESC     CON    0           EM ADDRESSING SHIFT COUNT (-3,-4,-5,-6)
 MID      CON    2RAA        MACHINE ID
 MIN      CON    0           MACHINE INDEX
 MMK      CON    0           MACHINE MASK
 MIL      CON    0           MIN*2+1  (MST INTERLOCKS)
 MRT      CON    0           MRT ADDRESS (MIN * 100B)
 MSL      CON    0           MST LOCAL AREA OFFSET  (MIN * 6)
 MSA      CON    0           MASS STORAGE ALLOCATION AREA ADDRESS
 MDWB     CON    0           MAXIMUM DATA WRITTEN BUFFER COUNT
 NCME     CON    1           1 IF NOT CME MACHINE, 0 IF CME MACHINE
 NDCPC    CON    1           NOT A DUAL CPU MACHINE WITH CACHE
 NTRACE   CON    1           NON-ZERO IF TRACE DISABLED
 OSSM     CON    0           OPERATING SYSTEM SECURITY MODE
 BDT      CON    0           FWA - BDT
 IBST     CON    0           FWA - IBST   NOTE - THESE ADDRESSES
 PLT      CON    0           FWA - PLT           MUST BE CONSECUTIVE
 CCT      CON    0           FWA - CCT           SO THAT THEY MATCH
 PUT      CON    0           FWA - PUT           THE ORDER IN *BDT*.
 FTT      CON    0           FWA - FTT
 HAT      CON    0           FWA - HAT
 CBT      CON    0           FWA - CBT
 BLMB     CON    0           BUFFER LIST MANAGEMENT POINTERS
 EMTB     CON    0           EMPTY BUFFER LIST
 DWTB     CON    0           DATA WRITTEN LIST
 DRDB     CON    0           DATA READ LIST
 WRTB     CON    0           WRITE BUFFER LIST
 IORQ     CON    ZERL        I/O REQUEST
 NIOB     CON    0           NUMBER OF I/O BUFFERS
 NRUN     CON    0           NUMBER OF BUFFERED DEVICE UNITS
 MXM      CON    0           MAXIMUM MEMORY - CM + ECS/ESM/UEM
 NOTDCE   CON    1           DUAL CPU USER ECS TRANSFER NOT ALLOWED
 NOTUEM   CON    0           NON-UEM FLAG
 UEM      CON    0           UEM FLAG
 UEM180   CON    0           FLAG FOR 180 IN EXTENDED MODE WITH UEM
 XUEM     CON    0           USER EM IN EXTERNAL EXTENDED MEMORY FLAG
 CXPFE    CON    EEMC        CPUCIO PSEUDO PP XP FLAGS AND EXIT MODE
 EXPFEB   CON    7027B       176 CHANNEL EXCHANGE PACKAGE FLAGS
 EXPFEC   CON    0
 PXPFE    CON    EEMC-1      PROGRAM MODE XP FLAGS AND EXIT MODE
 XPFE     CON    EEMC        MONITOR MODE XP FLAGS AND EXIT MODE
 PCPA     CON    0           FWA OF PSEUDO CONTROL POINT AREA
 NPCP     CON    0           NUMBER OF PCP-S
 PCM2     CON    0           (LAST PCP NUMBER + 1) * 200B
 SCA      CON    6000B       ADDRESS OF SYSTEM CONTROL POINT
 SC       CON    30B         SYSTEM CONTROL POINT NUMBER
 SDA      CON    0           FWA OF STATISTICAL DATA AREA
 SFCS     CON    4           SFCALL CM TRANSFER RATE SHIFT
 SFES     CON    3           SFCALL ECS TRANSFER RATE SHIFT
 SFFO     CON    70D*10B     SFCALL FUNCTION OVERHEAD (MICROSEC*10B)
 SMXF     CON    0           STORAGE MOVE XP MODIFICATION FLAG
 SP       CON    0           PSEUDO-PP INPUT REGISTER ADDRESS
 SPX      CON    0           PSEUDO-PP EXTENDED COMM. BLOCK ADDRESS
 SSCT     CON    0           FWA TABLE OF SUBSYSTEM CONTROL POINTS
 NVESS    CON    0           *SSCT* WORD CONTAINING *NVE* BYTE
 NVEOS    CON    0           OFFSET OF *NVE* BYTE IN *SSCT* WORD
 TNSC     CON    0           TRACK SHIFT COUNT
 TCNT     CON    20B         TRACK SIZE
 TM64     VFD    42/0,18/MP64
 TM66     VFD    42/0,18/MP66
 T173     VFD    42/0,18/MP73
 T175     VFD    42/0,18/MP75
 T176     VFD    42/0,18/MP76
 T810     VFD    42/0,18/MP10
 T815     VFD    42/0,18/MP15
 T825     VFD    42/0,18/MP25
 T830     VFD    42/0,18/MP30
 T835     VFD    42/0,18/MP35
 T840     VFD    42/0,18/MP40
 T845     VFD    42/0,18/MP45
 T850     VFD    42/0,18/MP50
 T855     VFD    42/0,18/MP55
 T860     VFD    42/0,18/MP60
 T865     VFD    42/0,18/MP86
 T875     VFD    42/0,18/MP87
 T961     VFD    42/0,18/MP961
 T963     VFD    42/0,18/MP963
 T990     VFD    42/0,18/MP90
 UESC     CON    0           USER EM SHIFT COUNT
 
**        THE FOLLOWING LOCATIONS DEFINE CONDITIONS WHICH ARE PRESENT.
 
 
 TDBL     BSS    0           TABLE OF BLOCKS FOR LOAD
 
 CME      VFD    60/0LCME    NON ZERO IF CME BLOCK PRESENT
 CMU      VFD    60/0LCMU    NON-ZERO IF CMU PRESENT
 CMUMTR   VFD    60/0LCMUMTR NON-ZERO IF CMUMTR BLOCK PRESENT
 CPB      VFD    60/0LCPB    NON-ZERO IF CPUMTR BREAKPOINT PRESENT
 CPP      VFD    60/0LCPP    NON-ZERO IF CPP-S ARE PRESENT
 CP176    VFD    60/0LCP176  NON-ZERO IF 176 CPU PRESENT
 CP830    VFD    60/0LCP830  NON-ZERO IF CYBER 810/830 WITH 20 PP-S
 DCP      VFD    60/0LDCP    NON-ZERO IF DUAL CPU PRESENT
 ECS      VFD    60/0LECS    NON-ZERO IF ECS PRESENT
 EEC      VFD    60/0LEEC    NONZERO IF EXTERNAL ECS PRESENT
 EUE      VFD    60/0LEUE    NONZERO IF ECS OR USER ECS PRESENT
 BIOMMF   VFD    60/0LBIOMMF
 BUFIO    VFD    60/0LBUFIO  NON-ZERO IF BUFFERED I/O IN USE
 IH819    VFD    60/0LIH819  NON-ZERO IF 819 DEVICES IN USE
 IHPFMD   VFD    60/0LIHPFMD NON-ZERO IF 885-42 DEVICES IN USE
 ISD      VFD    60/0LISD    NON-ZERO IF INDEPENDENT SHARED DEVICES
 ISDMMF   VFD    60/0LISDMMF NON-ZERO IF ISD OR MMF
 LSPMMF   VFD    60/0LLSPMMF NON-ZERO IF ONLY LSP ACCESS TO MMF LINK
 MMF      VFD    60/0LMMF    NON-ZERO IF MMF VIA CPU  ACCESS
 NVE      VFD    60/0LNVE    NON-ZERO IF *DSCB* PRESENT
 PCP      VFD    60/0LPCP    NON-ZERO IF PSEUDO-CONTROL POINTS PRESENT
 SUBCP    VFD    60/0LSUBCP  NON-ZERO IF SUB-CONTROL POINTS ALLOWED
 SCP      VFD    60/0LSCP    NON-ZERO IF SYSTEM CONTROL POINT PRESENT
 SUE      VFD    60/0LSUE    NONZERO IF SIMULTANEOUS UEM/ESM PRESENT
 PROBE    VFD    60/0LPROBE  NON-ZERO IF PROBE ENABLED
 MCE      VFD    60/0LMCE    NON-ZERO IF MEMORY CLEARING ENABLED
 TRACE    VFD    60/0LTRACE  NON-ZERO IF TRACE ENABLED
 UEC      VFD    60/0LUEC    NON-ZERO IF USER ECS IS PRESENT
 VMS      VFD    60/0LVMS    NON-ZERO IF MASS STORAGE VALIDATION ENABLED
 
 TDBLL    CON    0           END OF TABLE
 
 ECM      CON    0           NON-ZERO IF ECS PREFERRED FOR STORAGE MOVE
*                            WHICH IS ECS SIZE .GT. 256K OR NO CMU
 SCM      SPACE  4,10
**        SCM - SET CP TIME MULTIPLIERS.
*         ENTRY  (CPUL) = CPU FLAGS.
*         EXIT   (/MONITOR/CPTA) = CPU 0 MULTIPLIER (S0).
*                (/MONITOR/CPTA+1) = CPU 1 MULTIPLIER (S1).
*
*         THE MULTIPLIERS ARE USED BY /MONITOR/CPT WHEN
*         CALCULATING CP TIME (CP = S0*CP0 + S1*CP1).  IF A
*         MULTIPLIER IS DEFINED AS 0.0 OR 1.0, AN INTEGER ZERO (60/0)
*         IS STORED AND THE MULTIPLY IS NOT PERFORMED.  A MULTIPLY
*         BY 0.0 WOULD NEGATE CP ACCUMULATION AND PREVENT TIME-SLICING.
*         A MULTIPLY BY 1.0 IS REDUNDANT.  /MONITOR/CPT PERFORMS A ZERO
*         CHECK BEFORE PERFORMING THE MULTIPLY.
 
 
 SCM      PS                 ENTRY/EXIT
          MX0    0
          BX4    X4-X4
          SA1    IPRL        RETRIEVE IPRDECK PARAMETERS FROM CPM ENTRY
          MX2    -6
          LX1    6
          BX3    -X2*X1
          LX1    6
          BX2   -X2*X1
          ZR     X2,SCM1     IF NO CPU0 PARAMETER
          SX0    TIPR-1+X2   ADDRESS OF CPU0 VALUE
          MX4    30
          LX0    30          POSITION FOR CPU0
 SCM1     ZR     X3,SCM2     IF NO CPU1 VALUE
          SX3    TIPR-1+X3   ADDRESS OF CPU1 VALUE
          BX0    X3+X0
          MX2    -18
          BX4    -X2+X4
 SCM2     ZR     X4,SCM4     IF NO IPRDECK CHANGES
          SB3    TCPML       NUMBER OF ENTRIES TO MODIFY
 SCM3     SB3    B3-B1
          SA1    TCPM+B3     RETRIEVE ENTRY
          BX6    -X4*X1      CLEAR ADDRESSES TO BE REPLACED
          BX6    X0+X6       INSERT NEW ADDRESSES
          SA6    A1          REPLACE ENTRY
          NZ     B3,SCM3     IF NOT END OF ENTRIES
 SCM4     SA1    MABL        FORM INDEX INTO MULTIPLIER TABLE
          MX2    -2
          LX1    59-47
          NG     X1,SCM7     IF NOT CYBER 170-8X5
          SX7    4000        SET MULTIPLIERS FOR MICRO SECOND COUNTER
          SA7    /MONITOR/CPTA
          SA7    /MONITOR/CPTA+1
          LX1    59-42-59+47
          PL     X1,SCM6     IF CYBER 170-865/875
          SA1    TMNBA       GET *TCPM* INDEX
          ZR     X1,SCM      IF INDEX NOT FOUND
          EQ     SCM8        PROCESS CPU MULTIPLIER
 
 SCM6     LX1    0-38-59+42  GET 865/875 FLAG
          SX6    B1+
          BX1    X6*X1
          SX1    X1+TCPMH-TCPM
          EQ     SCM8        PROCESS CPU MULTIPLIER
 
 SCM7     LX1    0-37-59+47
          MX2    -1
          BX3    -X2*X1      CPU 1 PRESENT FLAG
          LX1    1-40-0+37
          LX2    1-0
          BX6    -X2*X1      INSTRUCTION STACK PRESENT FLAG
          BX3    X3+X6
          LX1    2-42-1+40
          LX2    2-1
          BX6    -X2*X1      CYBER 170 FLAG
          BX3    X6+X3
          MX2    -3
          BX3    -X3         COMPLEMENT FLAGS
          BX1    -X2*X3
          SX6    X1-TCPML
          PL     X6,SCM      IF INDEX OUT OF RANGE
          TX3    EXPA
          ZR     X3,SCM8     IF NOT A CYBER 176
          SX1    7           SET CYBER 176 INDEX
          SX7    110         SET CONVERSION FACTOR TO CONVERT CLOCK
          SA7    /MONITOR/CPTA  CYCLES TO QUARTER NANOSECONDS
          SA7    /MONITOR/CPTA+1
 SCM8     SA1    TCPM+X1     GET TABLE ENTRY
          SX2    X1          (X2) = CPU 1 MULTIPLIER ADDR
          AX1    30          (X1) = CPU 0 MULTIPLIER ADDR
 
*         SET CPU 0 MULTIPLIER (S0).
 
          ZR     X1,SCM9     IF NO CPU 0 MULTIPLIER
          SA1    X1+         GET MULTIPLIER
          SA3    SCMA
          BX6    X1-X3
          SA3    A3+B1
          ZR     X6,SCM9     IF NULTIPLIER = 0.0
          BX6    X1-X3
          ZR     X6,SCM9     IF MULTIPLIER = 1.0
          SA3    /MONITOR/CPTA  BIAS CONSTANTS WITH CPU 0 MULTIPLIER
          PX3    X3
          NX3    X3
          RX7    X3*X1
          UX7,B3 X7
          LX7    B3
          SA7    A3+
 
*         SET CPU 1 MULTIPLIER (S1).
 
 SCM9     ZR     X2,SCM10    IF NO CPU 1 MULTIPLIER
          SA2    X2+         GET MULTIPLIER
          SA3    SCMA
          BX6    X2-X3
          SA3    A3+B1
          ZR     X6,SCM10    IF MULTIPLIER = 0.0
          BX6    X2-X3
          ZR     X6,SCM10    IF MULTIPLIER = 1.0
          SA3    /MONITOR/CPTA+1  BIAS CONSTANT WITH CPU 1 MULTIPLIER
          PX3    X3
          NX3    X3
          RX7    X3*X2
          UX7,B3 X7
          LX7    B3
          SA7    A3
 
*         SET MULTIPLIER FOR APPLICATION USAGE ACCOUNTING.
 
 SCM10    SA4    ACPL        CHECK FOR CPU 0
          SA3    SCMB
          NG     X4,SCM11    IF CPU 0 OFF
          ZR     X1,SCM      IF CPU 0 MULTIPLIER = 0.0
          BX7    X1-X3
          ZR     X7,SCM      IF CPU 0 MULTIPLIER = 1.0
          BX6    X1
          EQ     SCM12       CALCULATE INVERSE MULTIPLIER
 
 SCM11    ZR     X2,SCM      IF CPU 1 MULTIPLIER = 0.0
          BX7    X2-X3
          ZR     X7,SCM      IF CPU 1 MULTIPLIER = 1.0
          BX6    X2
 
 SCM12    RX6    X3/X6       CALCULATE RECIPROCAL OF CPU MULTIPLIER
          SA6    /MONITOR/ACTC  SET APPLICATION ACCOUNTING MULTIPLIER
          EQ     SCM         EXIT
 
 SCMA     CON    0.0
 SCMB     CON    1.0
 TCPM     SPACE  4
**        TABLE OF ADDRESSES FOR CPU 0 (S0) AND CPU 1 (S1) MULTIPLIERS.
*
*         ENTRY FORMAT.
*         30/  ADDR OF CPU 0 MULTIPLIER,30/  ADDR OF CPU 1 MULTIPLIER
*
*         INDEX TO ENTRY FOR CYBER 176 IS 7.
*         INDEX TO ENTRY FOR CYBER 170-815/825/835/855 IS
*         12D + CYBER 865/875 FLAG (0 OR 1).
*         INDEX FOR ALL OTHER CYBER 6000 AND CYBER 170
*         MAINFRAMES IS CALCULATED BY THE FORMULA -
*         1/  X,1/  Y,1/  Z
*         X = CYBER 170.
*         Y = CPU 0 HAS INSTRUCTION STACK
*         Z = CPU 1 EXISTS.
*         X, Y, AND Z ARE EXTRACTED FROM CM WORD *MABL*.
 
 
 TCPM     BSS    0           FWA
 
          TVFD   30/,TM64     6200/6400
          VFD    30/0
 
          TVFD   30/,TM64     6500
          TVFD   30/,TM64
 
          TVFD   30/,TM66     6600
          VFD    30/0
 
          TVFD   30/,TM66     6700
          TVFD   30/,TM64
 
          TVFD   30/,T173     CYBER 172/173
          VFD    30/0
 
          TVFD   30/,T173     CYBER 174
          TVFD   30/,T173
 
          TVFD   30/,T175     CYBER 175
          VFD    30/0
 
          TVFD   30/,T176     CYBER 176
          VFD    30/0
 
 TCPMA    TVFD   30/,T815    CYBER 170-815
          VFD    30/0
 
 TCPMB    TVFD   30/,T825    CYBER 170-825
          VFD    30/0
 
 TCPMC    TVFD   30/,T835    CYBER 170-835
          VFD    30/0
 
 TCPMD    TVFD   30/,T845    CYBER 170-845
          VFD    30/0
 
 TCPME    TVFD   30/,T855    CYBER 170-855
          VFD    30/0
 
 TCPMF    TVFD   30/,T810    CYBER 180-810
          TVFD   30/,T810
 
 TCPMG    TVFD   30/,T830    CYBER 180-830
          TVFD   30/,T830
 
 TCPMI    TVFD   30/,T840    CYBER 180-840
          VFD    30/0
 
 TCPMJ    TVFD   30/,T850    CYBER 180-850
          VFD    30/0
 
 TCPMK    TVFD   30/,T860    CYBER 180-860
          TVFD   30/,T860
 
 TCPMH    TVFD   30/,T865    CYBER 170-865
          TVFD   30/,T865
 
          TVFD   30/,T875    CYBER 170-875
          TVFD   30/,T875
 
 TCPMN    TVFD   30/,T961    CYBER 180-960-11
          VFD    30/0
 
 TCPMO    TVFD   30/,T963    CYBER 180-960-31/32
          TVFD   30/,T963
 
 TCPMM    TVFD   30/,T990    CYBER 180-990
          TVFD   30/,T990
 
 TCPML    EQU    *-TCPM      NUMBER OF ENTRIES
 TMNB     SPACE  4,10
**        TMNB - TABLE OF CYBER 180 MODEL NUMBERS.
*
*         *TMNB* IS USED TO DETERMINE THE INDEX INTO
*         THE *TCPM* TABLE BASED ON THE MODEL NUMBER
*         ASSOCIATED WITH THE CYBER 180 PROCESSOR.
*         *TMNB* ALSO CONTAINS THE ACCOUNTING ADJUSTMENT
*         FOR THE ASSOCIATED PROCESSORS.
*
*T        12/ ACCT ADJ,18/ *TCPM* INDEX,30/ MODEL NUMBER
 
 
 TMNB     BSS    0
          VFD    12/38,18/TCPMF-TCPM,30/0#14  CYBER 180-810
          VFD    12/38,18/TCPMA-TCPM,30/0#11  CYBER 170-815
          VFD    12/38,18/TCPMA-TCPM,30/0#15  CYBER 180-815S
          VFD    12/34,18/TCPMB-TCPM,30/0#10  CYBER 170-825
          VFD    12/34,18/TCPMB-TCPM,30/0#12  CYBER 170-825
          VFD    12/34,18/TCPMB-TCPM,30/0#16  CYBER 180-825S
          VFD    12/34,18/TCPMG-TCPM,30/0#13  CYBER 180-830
          VFD    12/28,18/TCPMC-TCPM,30/0#20  CYBER 170-835
          VFD    12/28,18/TCPMI-TCPM,30/0#34  CYBER 180-840
          VFD    12/28,18/TCPMD-TCPM,30/0#37  CYBER 180-840S
          VFD    12/24,18/TCPMD-TCPM,30/0#31  CYBER 170-845
          VFD    12/24,18/TCPMD-TCPM,30/0#35  CYBER 180-845S
          VFD    12/24,18/TCPMJ-TCPM,30/0#33  CYBER 180-850
          VFD    12/20,18/TCPME-TCPM,30/0#30  CYBER 170-855
          VFD    12/20,18/TCPME-TCPM,30/0#36  CYBER 180-855S
          VFD    12/20,18/TCPMK-TCPM,30/0#32  CYBER 180-860
          VFD    12/18,18/TCPMN-TCPM,30/0#3B  CYBER 180-960-11
          VFD    12/12,18/TCPMO-TCPM,30/0#3A  CYBER 180-960-31/32
          VFD    12/06,18/TCPMM-TCPM,30/0#40  CYBER 180-990
          VFD    12/06,18/TCPMM-TCPM,30/0#41  CYBER 180-990 MODEL B
          VFD    12/06,18/TCPMM-TCPM,30/0#44  CYBER 180-994
          CON    0           END OF TABLE
 TMNBA    CON    0           *TCPM* INDEX SET BY *SSP*
 
*         HARDWARE DETECTABLE CPU HEAD TYPES.
 
 MP64     CON    "CP64M"     6200/6400
 MP66     CON    "CP66M"     6600
 MP73     CON    "C173M"     CYBER 172/173
 MP75     CON    "C175M"     CYBER 175
 MP76     CON    "C176M"     CYBER 176
 MP10     CON    "C810M"     CYBER 180-810
 MP15     CON    "C815M"     CYBER 170-815
 MP25     CON    "C825M"     CYBER 170-825
 MP30     CON    "C830M"     CYBER 180-830
 MP35     CON    "C835M"     CYBER 170-835
 MP40     CON    "C840M"     CYBER 180-840
 MP45     CON    "C845M"     CYBER 170-845
 MP50     CON    "C850M"     CYBER 180-850
 MP55     CON    "C855M"     CYBER 170-855
 MP60     CON    "C860M"     CYBER 180-860
 MP86     CON    "C865M"     CYBER 170-865
 MP87     CON    "C875M"     CYBER 170-875
 MP961    CON    "C961M"     CYBER 180-960-11
 MP963    CON    "C963M"     CYBER 180-960-31/32
 MP90     CON    "C990M"     CYBER 180-990
 TIPR     SPACE  4
*         SELECTABLE (VIA IPRDECK ENTRY CPM) CPU HEAD TYPES.
*
*         THIS LIST MUST BE IN THE SAME ORDER AS THE LIST IN *COMSSRU*.
 
 TIPR     BSS    0
          LOC    1
 
          CON    "CP62M"     6200
          CON    "CP64M"     6400
          CON    "CP65M"     6500
          CON    "CP66M"     6600
          CON    "CP67M"     6700
          CON    "CP71M"     CYBER 71
          CON    "CP72M"     CYBER 72
          CON    "CP73M"     CYBER 73
          CON    "CP74M"     CYBER 74
          CON    "C171M"     CYBER 171
          CON    "C172M"     CYBER 172
          CON    "C173M"     CYBER 173
          CON    "C174M"     CYBER 174
          CON    "C175M"     CYBER 175
          CON    "C176M"     CYBER 176
          CON    "C720M"     CYBER 170-720
          CON    "C730M"     CYBER 170-730
          CON    "C740M"     CYBER 170-740
          CON    "C750M"     CYBER 170-750
          CON    "C760M"     CYBER 170-760
          CON    "C810M"     CYBER 180-810
          CON    "C815M"     CYBER 170-815
          CON    "C825M"     CYBER 170-825
          CON    "C830M"     CYBER 180-830
          CON    "C835M"     CYBER 170-835
          CON    "C840M"     CYBER 180-840
          CON    "C845M"     CYBER 170-845
          CON    "C850M"     CYBER 180-850
          CON    "C855M"     CYBER 170-855
          CON    "C860M"     CYBER 180-860
          CON    "C865M"     CYBER 170-865
          CON    "C875M"     CYBER 170-875
          CON    "C961M"     CYBER 180-960-11
          CON    "C963M"     CYBER 180-960-31/32
          CON    "C990M"     CYBER 180-990
          CON    "ICM1M"     INSTALLATION DEFINED - 1
          CON    "ICM2M"     INSTALLATION DEFINED - 2
          CON    "ICM3M"     INSTALLATION DEFINED - 3
          CON    "ICM4M"     INSTALLATION DEFINED - 4
          CON    "ICM5M"     INSTALLATION DEFINED - 5
          ERRNZ  *-TIPRL     TABLE SIZE CHANGED
 
          LOC    *O
 SCD      SPACE  4,10
**        SCD - SET CHANNEL DATA.
*
*         THIS SUBROUTINE RECONSTRUCTS THE CHANNEL ACCESS BYTE IN EACH
*         MST ENTRY, CLEARS THE IDLE FLAG IN EACH CHANNEL STATUS TABLE
*         ENTRY AND ENSURES THAT ALL CHANNEL STATES ARE EITHER *UP* OR
*         *DOWN*.
*
*         CALLS  /MONITOR/RCB, /MONITOR/SCH.
 
 
 SCD      PS                 ENTRY/EXIT
          SX7    3           CHANNEL STATE MASK
          SB4    NOPE
          SA2    ESTP
          MX0    -12
          AX2    12
          BX2    -X0*X2      LAST MASS STORAGE ORDINAL + 1
          SB7    X2-1
 SCD1     LT     B7,B4,SCD4  IF END OF EST SCAN
          SX1    B7
          SB7    B7-B1       DECREMENT EST ORDINAL
          SB5    48
          SB2    B5+B1
          CX3    X1,EST      CONVERT EST ORDINAL TO OFFSET
          TA3    X3+EQDE,EST READ EST ENTRY
          PL     X3,SCD1     IF NOT MASS STORAGE
 SCD2     SB5    B5-12
          SB3    B5-12
          SB6    SCD1        *RCB* EXIT ADDRESS
          EQ     B3,B0,SCD3  IF BOTH CHANNELS PROCESSED
          SB3    B2-B5
          LX6    X3,B3
          AX6    59
          BX6    X6*X7       =0 IF *UP*/*IDLE*, =3 IF *DOWN*
          SB6    SCD2        *SCH* EXIT ADDRESS
          EQ     /MONITOR/SCH  SET CHANNEL STATE
 
 SCD3     BX5    -X0*X3
          LX5    3           MST ADDRESS
          EQ     /MONITOR/RCB  RECONSTRUCT CHANNEL ACCESS BYTE IN MST
 
 SCD4     SA2    CHTP
          SA3    SCDA        IDLE FLAG MASK
          SB6    CTALL       CHANNEL TABLE LENGTH
          SB7    B0
          AX2    12
 SCD5     SA4    X2+B7       READ NEXT CHANNEL TABLE WORD
          SB7    B7+B1       ADVANCE CHANNEL TABLE INDEX
          BX7    -X3*X4      CLEAR IDLE FLAGS
          SA7    A4
          EQ     B7,B6,SCD   IF END OF CHANNEL TABLE
          EQ     SCD5        PROCESS NEXT CHANNEL TABLE WORD
 
 
 SCDA     CON    01000100010001000100B  IDLE FLAG MASK
 SCS      SPACE  4
**        SCS - SET CPU STATUS.
*
*         EXIT   (A0) = NEXT EXCHANGE ADDRESS.
 
 
 SCS      PS                 ENTRY/EXIT
          SA2    ACPL        SET CPU 0 IDLE
          SA3    A2+B1
          BX6    X2+X3
          SX7    B1
          BX1    X3
          PL     X6,SCS2     IF 2 CPU,S
          SX7    B0
          SB4    TPPR        CLEAR CPU SELECTION BITS
          SB5    TPPRL
          SX4    B1
          LX4    58-0
          TJP    (/PRESET/SCS0,SUBCP,/PRESET/SCS1)  CHECK SUBCP
 
 SCS0     SA3    /MONITOR/TXJP  DISABLE SUBCONTROL POINT XP FOR CPU1
          BX6    X3
          SA6    A3+B1
 SCS1     SA3    B4
          BX6    -X4*X3
          SB4    B4+B1
          SA6    A3
          NE     B4,B5,SCS1  IF NOT END OF TABLE
 SCS2     TA3    CWQW,SCA    SET CPU SELECTION FOR PROGRAM MODE
          LX7    24-0
          BX7    X3+X7
          SA7    A3
          SX3    /MONITOR/IXP
          SX4    MIXT
          BX6    X2+X3
          NG     X6,SCS3     IF CPU 0 TURNED OFF
          NG     X1,SCS4     IF 1 CPU
          SA6    A2
          LX4    42
          BX6    X4+X3       SET EXCHANGE PACKAGE TYPE AND ADDRESS
          SA3    SCA
          LX3    24
          BX6    X6+X3       SET SYSTEM CONTROL POINT
          SA6    CPAL
          SA3    SCSC        ENABLE DUAL-CP EXTENSIONS
          BX7    X3
          SA3    A3+B1
          ERRNZ  SCSD-SCSC-1
          SA7    /MONITOR/BNJ15
          NO
          BX7    X3
          SA7    /MONITOR/RCCB
          SX3    /DCP/IXP1
          SX4    DIXT
 SCS3     SA2    A2+1        SET CPU 1 IDLE PACKAGE
          BX6    X2+X3
 SCS4     SA6    A2
          LX4    42
          BX6    X4+X3       SET EXCHANGE PACKAGE TYPE AND ADDRESS
          SA3    SCA
          LX3    24
          BX6    X6+X3       SET SYSTEM CONTROL POINT
          SA6    A2+CPAL-ACPL
          SA1    DCPC
          ZR     X1,SCS5     IF NOT DUAL CPU MACHINE WITH CACHE
          SA1    EIBP        SET EXCHANGE PACKAGE ADDRESS
          MX7    42
          LX7    32
          SX6    /DCP/SCX1   EXCHANGE PACKAGE FOR IDLE PROGRAM STARTUP
          BX1    X7*X1
          LX6    32
          BX6    X1+X6
          SA6    A1
          SA1    SCSE        SET IDLE PACKAGE PROGRAM FOR CPU1
          BX6    X1
          SA6    /DCP/IDL1+2
 SCS5     SA0    /MONITOR/PXP
          EQ     SCS         RETURN
 
 SCSC     EQ     /DCP/BNJ
 
 SCSD     EQ     /DCP/RCC
 
 SCSE     EQ     2           LOOP WITHOUT DELAY
 SDT      SPACE  4,20
**        SDT - SET DATE AND TIME FROM *CTI*-SUPPLIED VALUES.
*
*         IN ORDER TO PROVIDE A VALID DATE AND TIME ON THE DISPLAY
*         AS SOON AS POSSIBLE, THIS ROUTINE IS CALLED AT THE BEGINNING
*         OF *CPUMTR* PRESET.  BECAUSE OF THE LENGTH OF TIME REQUIRED
*         TO EXECUTE *CPUMTR* PRESET, THIS ROUTINE WILL BE CALLED AGAIN
*         AT THE END OF *CPUMTR* PRESET TO MAINTAIN CLOCK PRECISION.
*
*         THIS CODE IS DERIVED FROM THE *FTN5* COMPILER OBJECT
*         CODE PRODUCED FOR A FORTRAN VERSION OF THE ALGORITHM
*         DEVELOPED IN *CYBIL* FOR NOS/VE.
*
*         ENTRY  (TIML) = *CTI*-SUPPLIED PACKED BASE TIME (FIRST CALL).
*                (DTEL) = *CTI*-SUPPLIED PACKED BASE DATE (FIRST CALL).
*                (PDTL) = *CTI*-SUPPLIED *FRC* BASE VALUE (FIRST CALL).
*
*         EXIT   (DTEL) = CURRENT DISPLAY CODE DATE.
*                (TIML) = CURRENT DISPLAY CODE TIME.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 7.
*
*         MACROS EDATE, ETIME.
 
 
 SDT      SUBR               ENTRY/EXIT
 
*         SAVE *CTI*-SUPPLIED VALUES ON INITIAL CALL.
 
          SA1    SDTB
          NZ     X1,SDT0     IF NOT FIRST CALL TO *SDT*
          SA1    TIML        SAVE *CTI*-SUPPLIED PACKED BASE TIME
          SA2    DTEL        SAVE *CTI*-SUPPLIED PACKED BASE DATE
          BX6    X1
          LX7    X2
          SA1    PDTL        SAVE *CTI*-SUPPLIED *FRC* BASE VALUE
          SA6    SDTA
          SA7    SDTB
          BX6    X1
          SA6    SDTC
 
*         CHECK MAINFRAME TYPE.
 
 SDT0     SA1    MABL
          LX1    59-47
          NG     X1,SDTX     IF NOT A CME MAINFRAME
 
*         INITIALIZE *RTC* VARIABLES.
 
          SA3    /CME/RTCC   INITIALIZE REAL TIME CLOCK
          RC     X6          GET CURRENT *FRC* VALUE
          BX7    X3
          SA6    /CME/RTCA   INITIALIZE WHOLE MILLISECOND BASE TIME
          SA7    RTCL
          SA6    /CME/RTCB   INITIALIZE WHOLE SECOND BASE TIME
          LX1    59-42-59+47
          PL     X1,SDTX     IF CYBER 865/875
 
*         CALCULATE ELAPSED TIME SINCE CTI-SUPPLIED DATE/TIME.
 
          SA5    SDTC        GET CTI-SUPPLIED *FRC* VALUE
          IX6    X6-X5
          PL     X6,SDT1     IF CTI *FRC* VALID (.LT. CURRENT *FRC*)
          SX6    0           USE CTI-SUPPLIED DATE/TIME INTACT
 SDT1     SA6    FRC
          SA4    =500000     ROUND UP TO NEAREST WHOLE SECOND
          SA3    =1000000.0
          IX0    X6+X4
          PX7    X0
          FX0    X7/X3
          UX7,B2 X0
 
*         CALCULATE CURRENT TIME.
 
          SA5    =60.0       ADVANCE SECONDS
          LX0    B2,X7
          PX7    X0
          FX6    X7/X5
          UX7,B2 X6
          SA5    SDTA        CONVERT PACKED DECIMAL SECONDS AND MINUTES
          BX6    X5
          BX4    X5
          MX3    -4
          LX6    56
          LX4    44
          BX2    -X3*X6
          BX6    -X3*X4
          BX4    X2
          LX7    B2,X7       UPDATE *FRC* TO BE ELAPSED MINUTES
          SX1    60
          LX4    2
          IX2    X4+X2
          BX4    X6
          LX4    2
          IX6    X4+X6
          DX4    X7*X1
          LX2    1
          IX0    X0-X4       CALCULATE NUMBER OF SECONDS TO ADVANCE
          BX4    X5
          BX5    -X3*X5
          LX4    48
          LX6    1
          IX2    X5+X2
          BX5    -X3*X4
          IX6    X5+X6
          SA7    FRC
          IX7    X0+X2
          SA6    MN
          SA7    SS
          IX7    X7-X1
          NG     X7,SDT2     IF NO MINUTE CHANGE
          SA7    A7
          SX0    B1
          IX7    X0+X6
          SA7    A6
 SDT2     SA5    FRC         ADVANCE MINUTES
          SA4    =60.0
          PX0    X5
          FX7    X0/X4
          SA4    SDTA        CONVERT PACKED DECIMAL HOURS
          BX0    X4
          LX0    32
          UX2,B2 X7
          BX7    -X3*X0
          SX0    60
          LX6    B2,X2       UPDATE *FRC* TO BE ELAPSED HOURS
          BX2    X7
          DX1    X6*X0
          LX2    2
          IX7    X2+X7
          SA2    MN
          LX4    36
          IX1    X5-X1       CALCULATE NUMBER OF MINUTES TO ADVANCE
          BX5    -X3*X4
          LX7    1
          IX7    X5+X7
          SA6    A5
          IX6    X2+X1
          SA7    HH
          SA6    A2
          IX6    X6-X0
          NG     X6,SDT3     IF NO HOUR CHANGE
          SX0    B1
          IX7    X0+X7
          SA6    A6
          SA7    A7
 SDT3     SA5    FRC         ADVANCE HOURS
          SA4    =24.0
          PX0    X5
          FX7    X0/X4
          SA4    SDTB        CONVERT PACKED DECIMAL DAYS
          BX0    X4
          LX0    56
          UX2,B2 X7
          BX7    -X3*X0
          SX0    24
          LX6    B2,X2       UPDATE *FRC* TO ELAPSED DAYS
          BX2    X7
          DX1    X6*X0
          LX2    2
          IX7    X2+X7
          SA2    HH
          BX3    -X3*X4
          IX4    X5-X1       CALCULATE NUMBER OF HOURS TO ADVANCE
          LX7    1
          IX7    X3+X7
          SA6    A5
          IX6    X2+X4
          SA7    DD
          SA6    A2
          IX6    X6-X0
          NG     X6,SDT4     IF NO DAY CHANGE
          SA6    A6
          SX0    B1
          IX6    X0+X7
          SA6    A7
 
*         CALCULATE CURRENT DATE.
 
 SDT4     SA5    SDTB        ADVANCE DATE
          BX0    X5
          LX0    32
          MX7    -4          CONVERT PACKED DECIMAL MONTH AND YEAR
          BX4    X5
          BX3    -X7*X0
          LX4    44
          BX0    X3
          BX2    -X7*X4
          LX0    2
          BX4    X2
          BX1    X5
          IX3    X0+X3
          LX4    2
          LX1    36
          IX0    X4+X2
          BX4    -X7*X1
          LX3    1
          LX5    48
          IX6    X4+X3
          BX4    -X7*X5
          LX0    1
          SA6    YY
          IX6    X4+X0
          SA6    MM
 
*         CALCULATE CURRENT MONTH AND DAY.
 
          SA5    MM
          SA4    YY
          SA3    DD
          SA2    FRC
          IX3    X3+X2
 
*         ADJUST YEAR, MONTH, DAY UNTIL DAY FITS WITHIN MONTH.
 
 SDT5     MX7    -2          CHECK FOR LEAP YEAR
          SX6    28
          BX7    -X7*X4
          NZ     X7,SDT5.1   IF NOT LEAP YEAR
          SX6    29
 SDT5.1   SA6    DAYS+1      RESET NUMBER OF DAYS IN FEBRUARY
 SDT6     SA1    X5+DAYS-1   ADJUST ELAPSED DAYS BY DAYS IN MONTH
          IX2    X1-X3
          PL     X2,SDT7     IF DAYS FIT WITHIN CURRENT MONTH
          SX5    X5+B1       ADVANCE MONTH
          IX3    X3-X1       DECREMENT ELAPSED DAYS
          SB7    X5-13
          NG     B7,SDT6     IF NOT YEAR ROLLOVER
          SX5    B1          RESET MONTH TO JANUARY
          SX4    X4+B1       ADVANCE YEAR
          EQ     SDT5        RECHECK FOR LEAP YEAR
 
*         CONVERT CALCULATED VALUES TO DISPLAY WALL CLOCK DATE/TIME.
 
 SDT7     SX1    X4-70       BIAS YEAR BY 1970
          PL     X1,SDT8     IF YEAR BEFORE 2000
          SX1    X1+100      ADJUST BIAS FOR YEARS 2000 - 2033
 SDT8     LX1    12          PACK DATE
          LX5    6
          BX1    X1+X5
          BX1    X1+X3
          EDATE  X1          CONVERT PACKED DATE TO DISPLAY CODE
          SA6    DTEL
          SA1    HH          PACK TIME
          LX1    12
          SA2    MN
          LX2    6
          SA3    SS
          BX1    X1+X2
          BX1    X1+X3
          ETIME  X1          EDIT TIME
          SA6    TIML
          EQ     SDTX        RETURN
 
 
 SDTA     CON    0           *CTI*-SUPPLIED PACKED BASE TIME
 SDTB     CON    0           *CTI*-SUPPLIED PACKED BASE DATE
 SDTC     CON    0           *CTI*-SUPPLIED BASE *FRC* VALUE
 
*         DATE/TIME CELLS.
 
 YY       BSS    1           YEAR
 MM       BSS    1           MONTH
 DD       BSS    1           DAY
 HH       BSS    1           HOUR
 MN       BSS    1           MINUTE
 SS       BSS    1           SECOND
 FRC      BSS    1           FREE RUNNING CLOCK
 
*         ARRAY CONTAINING THE NUMBER OF DAYS IN EACH MONTH.
 
 DAYS     DATA   31,28,31,30,31,30,31,31,30,31,30,31
*DAYS     DATA   31,29,31,30,31,30,31,31,30,31,30,31  (LEAP YEAR)
 SJB      SPACE  4,10
**        SJB - SETUP JOB CONTROL BLOCK TABLE.
*
*         EXIT   JCB SET UP FOR ALL SERVICE CLASSES.
*
*         USES   X - 4.
*                B - 3.
*
*         CALLS  /MONITOR/CCP.
 
 
 SJB      SUBR               ENTRY/EXIT
          SX4    MXJC        SET MAXIMUM SERVICE CLASS
          SB3    SJB1        SET RETURN ADDRESS
 SJB1     SX4    X4-1
          ZR     X4,SJBX     IF ALL SERVICE CLASSES PROCESSED
          EQ     /MONITOR/CCP  CONVERT CPU SCHEDULING PARAMETERS
 SSP      SPACE  4,10
**        SSP - SET SYSTEM PARAMETERS.
 
 
 SSP7.9   SA1    BIOL
          AX1    24
          SX7    X1
          ZR     X7,SSP      IF NO BUFFERED I/O
          SB6    X1+CBTP     LAST ENTRY
          SA7    BDT
          MX3    -18
          SX7    X7+BDTL
          SA2    X1-1
 SSP8     SA2    A2+B1       NEXT ENTRY
          BX6    X7+X2
          LX2    -24
          SA7    A7+B1
          SA6    A2
          BX4    -X3*X2
          IX7    X7+X4
          SX4    A2-B6
          NZ     X4,SSP8     IF MORE ENTRIES TO PROCESS
          SX6    X1+EMTP
          SX7    X1+DWTP
          SA6    EMTB
          SA7    DWTB
          SX6    X6-1
          SA6    BLMB
          SX6    X1+DRDP
          SX7    X1+WRTP
          SA6    DRDB
          SA7    WRTB
          SA2    X1+CBTP     GET NUMBER OF I/O BUFFERS
          SA4    X1+PUTP
          SX7    X1+IORQP
          LX2    12
          MX3    -12
          SA7    IORQ
          BX6    -X3*X2
          LX4    12
          SA6    NIOB
          BX7    -X3*X4
          AX6    2           SET MAXIMUM DATA WRITTEN TO 1/4 OF TOTAL
          SA7    NRUN
          SA6    MDWB
 
 SSP      PS                 ENTRY/EXIT
          SA2    EMBP
          LX2    -24         SET *EMB* POINTER
          SX7    X2
          SA7    EMB
 
*         SET CONTROL POINT AND PSEUDO-CONTROL POINT PARAMETERS.
 
          SA1    PCPP
          SX6    X1          SET PCP AREA ADDRESS
          MX0    -12
          ERRNZ  MCTP-PCPP   CODE DEPENDS ON VALUE
          AX1    24
          BX7    -X0*X1      NUMBER OF MCT ENTRIES
          SA6    PCPA
          AX1    12          POSITION TO MCT ADDRESS
          BX6    X1
          SA7    NMCT        SET MCT ENTRY COUNT
          SA6    MCT
          SA1    NCPL        SET SYSTEM CONTROL POINT NUMBER
          AX1    36
          BX6    -X0*X1
          SX6    X6+B1
          SA6    SC
          SX2    X6+B1       NUMBER OF CP-S (INCLUDING CP-0)
          LX6    7
          SA6    SCA         SET SYSTEM CONTROL POINT ADDRESS
          IX6    X7-X2       CALCULATE PCP COUNT
          SA6    NPCP
          LX7    7
          SA7    PCM2        SET MAXIMUM PCP OFFSET
 
*         SET PP CONFIGURATION PARAMETERS.
 
          SA2    PPCP        SET FIRST PP COMMUNICATION ADDRESS
          BX7    -X0*X2
          SA7    FP
          BX6    X7          SET FIRST PP COMMUNICATION ADDRESS/8
          AX6    3
          SA6    FP8
          LX2    -36
          SX6    X2
          SX3    X2
          SA6    FPX         SET EXTENDED PP COMMUNICATION BLOCKS FWA
          SA1    PPUL        SET CPP-S COMMUNICATION ADDRESS
          SX2    X1          GET NUMBER OF PHYSICALLY PRESENT CPP-S
          AX2    12D
          LX1    -24
          BX1    -X0*X1
          SX6    20D         NUMBER OF PP-S IN 2 BARREL SYSTEM
          SB2    X1-11D
          PL     B2,SSP.0    IF NOT 2 BARRELS
          SX6    10D
 SSP.0    LX6    3
          IX6    X6+X7
          SA6    FPC         ADDRESS OF CPP COMMUNICATION AREA
          ZR     X2,SSP0.1   IF NO CPP-S
          LX2    3
          IX6    X2+X6
 SSP0.1   SA6    SP          ADDRESS OF PSEUDO PP COMMUNICATION AREA
          IX7    X6-X7
          LX7    PPXES-PPCES
          IX7    X3+X7
          SA7    SPX         SET PSEUDO PP EXTENDED BLOCK ADDRESS
          SX7    0           CLEAR INPUT REGISTER
          SA7    X6+
 
*         SET CENTRAL AND EXTENDED MEMORY CONFIGURATION PARAMETERS.
 
          SA1    CFGL        GET HARDWARE ECS/ESM MODE
          SX6    B1+
          AX1    22
          BX6    X6*X1
          SA6    ESM         SET ESM MODE IF BIT IS SET
          SA1    MABL        CHECK FOR 8XX
          ZR     X6,SSP0.11  IF NOT ESM MODE
          LX1    59-47
          NG     X1,SSP0.10  IF NOT CYBER 8XX
          LX1    59-42-59+47
          NG     X1,SSP0.11  IF NOT CYBER 865/875
 SSP0.10  SA6    ESM170      SET 170 ESM MODE
 SSP0.11  BX6    X4          SET FL
          AX6    36
          BX7    X5          SET FLX
          LX7    -36
          SA6    MCM
          SA1    MEFL        GET EXPANDED ADDRESSING FLAG
          SA7    MEC
          SA7    MXM         SET MAXIMUM MEMORY
          AX6    6           SET FL SHIFTED
          SA6    MCMS
          LX1    59-31
          MX4    37
          SA3    EEC
          BX4    X4*X7
          BX7    X4-X7
          PL     X1,SSP0.12  IF NOT EXPANDED ADDRESSING
          SA6    ESM170      SET EXPANDED ADDRESSING INDICATOR
          LX7    6
 SSP0.12  AX4    9
          AX7    9           SET FLE / 1000B
          SA7    MECNF
          BX7    X4+X7       SET FLX FLAG BIT SHIFTED
          SA7    MECS
          MX4    -2          SET EXTENDED MEMORY SHIFT COUNT
          LX1    0-29-59+31
          BX7    -X4*X1
          SA7    TNSC
          SB4    X7
          SX7    X7-6        (0 TO 3)-6 = (-6 TO -3)
          MX4    -3          SET USER EM SHIFT COUNT
          SA7    MESC
          LX1    0-33-0+29   POSITION USER EM SHIFT COUNT
          BX7    -X4*X1
          SA7    UESC        STORE USER EM SHIFT COUNT
          SX1    20B
          LX7    B4,X1
          SA7    TCNT        SET TRACK SIZE
          SA1    MABL
          LX1    59-47
          NG     X1,SSP0.3   IF NOT CME
          LX6    6           SET MAXIMUM MEMORY
          SA6    MXM
          SX6    B0+         CLEAR THE NON-CME INDICATOR
          SA6    NCME
          SA1    MABL
          LX1    59-42
          MX7    -8
          PL     X1,SSP0.15  IF 170 - 865/875
          SA1    EABL+CPEI   GET PROCESSOR DESCRIPTOR POINTER
          LX1    18
          SA4    X1          ISOLATE MODEL NUMBER
          AX4    28
          SX2    TMNB
          SA1    X1+3        GET CYBER 990 LARGE MEMORY INDICATOR
          LX1    59-12
          PL     X1,SSP0.14  IF NOT A LARGE MEMORY CYBER 990
          SX6    B0+
          SA6    CCMB
          SA1    MEC         SET PROGRAM MODE FLE TO MACHINE FLE
          BX6    X1
          SA6    MECPRG
 SSP0.14  SA1    X2
          ZR     X1,SSP0.16  IF END OF TABLE
          SX2    X2+B1
          BX6    X1-X4
          BX6    -X7*X6
          NZ     X6,SSP0.14  IF NO MATCH ON MODEL NUMBER
          AX1    30          SET *TCPM* INDEX
          SX7    X1
          SA7    TMNBA
          MX7    -12
          AX1    18          SET ACCOUNTING ADJUSTMENT
          BX7    -X7*X1
          AX6    X7,B1
          SA7    ACAD
          SA6    ACAD2
          EQ     SSP0.16     SET/CLEAR CM COPY FLAG
 
 SSP0.15  SA4    UEML        SET USER EM IN EXTERNAL EM FLAG
          SX2    B1+B1
          BX6    X2*X4
          SA6    XUEM
 SSP0.16  SX6    EEMC+100B   CLEAR CM COPY FLAG TO ACCESS EXTERNAL EM
          SX7    EEMC+100B-1
          SX2    B1+B1
          SX4    B1+B1
          NZ     X3,SSP0.2   IF EXTERNAL ECS PRESENT
          SX6    EEMC+500B   SET CM COPY FLAG TO ACCESS INTERNAL ECS
          SX7    EEMC+500B-1
          SX4    B0+
 SSP0.2   SA1    ESM170      GET ADDRESSING MODE
          ZR     X1,SSP0.21  IF NOT EXPANDED ADDRESSING
          SX1    200B        SET EXPANDED ADDRESSING FLAG
          BX6    X6+X1
          BX7    X7+X1
 SSP0.21  SA6    XPFE
          SA7    PXPFE
          SA6    CXPFE
          SX6    EEMC-1+400B+100B
          BX6    X6+X1
          SA6    EXPFEC
          SA1    UEML
          BX2    X2*X1
          BX6    -X2*X4
          LX6    59-1
          AX6    18
          SA4    UEC         SET STORAGE MOVE XP FLAG IF EXTERNAL UEC
          LX1    12
          BX6    X6*X4
          SA6    SMXF
          ZR     X2,SSP0.3   IF UEM NOT PRESENT
          NZ     X3,SSP0.3   IF SIMULTANEOUS UEM/ESM
          BX6    -X0*X1
          SA2    MABL        CHECK FOR CYBER 180
          LX2    59-42
          SA1    ESM170      PICK UP EXPANDED MODE FLAG
          PL     X2,SSP0.22  IF CY170-865/875
          ZR     X1,SSP0.22  IF NOT IN EXPANDED MODE
          SA6    UEM180      SET 180 EXPANDED MODE FOR FAKE READ
 SSP0.22  BX2    X6          PRESERVE RAE/1000
          LX6    3           RAE/100
          NZ     X1,SSP0.23  IF EXPANDED MODE
          LX6    6           RAE
 SSP0.23  SA6    RXX         SET RXX VALUE FOR EXCHANGE PACKAGES
          BX6    X2          RESTORE RAE/1000 TO X6
          SA6    RAEX
          LX6    9
          SA1    MCM         INCLUDE UEM IN MAXIMUM MACHINE FL
          SA2    MEC
          SA6    A6-B1
          ERRNZ  RAEX-RAE-1  CODE DEPENDS ON CONSECUTIVE LOCATIONS
          IX6    X1+X2
          SA6    MXM
 
*         SET TABLE POINTERS.
 
 SSP0.3   SA1    SSTL
          LX1    59-29
          NG     X1,SSP0.32  IF TRACE DISABLED
          SX7    B0+
          SA7    NTRACE      CLEAR NON-TRACE INDICATOR
 SSP0.32  SA1    ESTP        READ EST POINTER
          LX1    24          SET EST FWA
          SX7    X1
          LX1    12          SET EST LENGTH
          BX6    -X0*X1
          SA7    EST
          SA6    ESTL
          LX1    12          SET LAST MASS STORAGE ORDINAL + 1
          BX6    -X0*X1
          SA6    IBOP        SAVE IN ROUTINE *IBO*
          SA1    EVTP        GET EVENT TABLE POINTER
          AX1    36
          SX6    X1          FWA EVENT TABLE
          SA6    EVT
          SA1    EPBP        GET ECS PP BUFFER POINTER
          MX4    -6
          SX6    X1          FWA ECS PP BUFFERS
          SA6    ECSB
          LX1    -18
          SX2    ECBL        LENGTH OF EACH PP ECS BUFFER
          BX4    -X4*X1      NUMBER OF PP ECS BUFFERS
          IX6    X4*X2
          SA6    ECSBL       SET PP ECS BUFFERS TOTAL LENGTH
          SA1    SSML        GET OPERATING SYSTEM SECURITY MODE
          MX6    -6
          LX1    12
          BX6    -X6*X1
          SA6    OSSM
          SA1    EXML        GET EXTENDED MEMORY EST ORDINAL
          MX6    -9
          BX6    -X6*X1
          SA6    EEM
          SA1    DFPP        SET DAYFILE POINTERS FWA
          LX1    24
          SB6    X6          (B6) = EM EST ORDINAL (CPU ACCESS)
          CX4    X6,EST      CONVERT EST ORDINAL TO OFFSET
          IX7    X7+X4
          SX6    X1
          SA6    DP
          SA1    FNTP        SET FWA/LWA OF FNT
          MX4    -24
          LX1    24
          BX6    -X4*X1
          BX2    X6
          SA6    FNT
          LX1    12
          BX6    -X0*X1      EXTRACT NUMBER OF ENTRIES IN FNT
          SA6    FNTM
          CX1    X6,FNT      LENGTH OF FNT
          IX6    X2+X1
          SA1    X7+         GET MST ADDRESS OF ECS
          NZ     B6,SSP0.4   IF ECS EQUIPMENT DEFINED
          SX7    B0          CLEAR ECS EST AND MST ADDRESSES
          BX1    X1-X1
 SSP0.4   SA6    FNTLWA      LWA+1 OF SYSTEM FNT
          SA7    EEN
          BX7    -X0*X1
          LX7    3           MST ADDRESS
          SA7    EMS
          SA1    EJTP        GET FWA OF EJT
          LX1    24
          BX6    -X4*X1
          SA6    EJT
          LX1    12
          BX6    -X0*X1      MAXIMUM NUMBER OF ENTRIES IN EJT
          SA6    EJTM
          SA1    SDAP        SET FWA STATISTICAL DATA AREA
          LX1    24
          BX6    -X4*X1
          SA6    SDA
          SA2    SSCP        GET FWA *SSCT* TABLE
          LX2    -12
          BX7    -X4*X2
          SA7    SSCT
          SA2    MABL        CHECK FOR CMU
          LX2    59-39
          PL     X2,SSP1     IF CMU PRESENT
          BX1    X2          CHECK IF CPU 0 HAS INSTRUCTION STACK
          LX1    59-40-59+39
          NG     X1,SSP2     IF NOT STACK MACHINE
          SA4    SFFO        DECREASE SFCALL FUNCTION TIME BY 1/2
          AX6    X4,B1
          SA6    A4
          SX7    B1          875 CM TRANSFER RATE SHIFT
          LX1    59-38-59+40
          SA7    SFCS
          NG     X1,SSP2     IF AN 875
 SSP1     SX7    2           SET SFCALL CM TRANSFER RATE SHIFT
          SA7    SFCS
 SSP2     SA4    UEML
          LX4    0-1
          SX6    B1
          BX6    X6*X4
          SA6    UEM         SET/CLEAR UEM FLAG
          NZ     X6,SSP4.1   IF UEM
          SX6    B1          SET NON-UEM FLAG
          SA6    NOTUEM
          ZR     B6,SSP5     IF NO EXTERNAL ECS EQUIPMENT
          SA1    MECNF
          SX6    X1-500000/1000B
          SX7    B0+
          PL     X6,SSP3     IF ECS SIZE .GE. 500K
          SX6    X1-256000/1000B
          SX7    B1
          PL     X6,SSP3     IF ECS SIZE .GE. 256K
          SX7    B1+B1
 SSP3     SA7    SFES        SET SFCALL ECS TRANSFER RATE SHIFT
          SA1    CME
          NZ     X1,SSP4.1   IF CME AVAILABLE
          PL     X6,SSP4     IF ECS SIZE .GE. 256K
          PL     X2,SSP4.1   IF CMU PRESENT
 SSP4     SX7    B1+         SET TO USE ECS
          SA7    ECM
 SSP4.1   SA1    UEC
          ZR     X1,SSP5     IF USER ECS NOT PRESENT
          BX7    X7-X7
          SA7    NOTDCE      ALLOW DUAL CPU USER ECS TRANSFER
          SX7    B1
          LX2    59-47-59+39
          PL     X2,SSP5     IF CM EXTENSION PRESENT
          SA1    /PROGRAM/SMPXP+CWQW  FORCE INTO CPU-0
          SA7    A7          PREVENT DUAL CPU USER ECS TRANSFER
          LX7    24
          BX7    X1+X7
          SA7    A1
 SSP5     SA1    JBCP        SET FWA OF JOB CONTROL BLOCK TABLE
          AX1    36
          BX6    X1
          SA6    JCB
          SA1    DSSL        GET RECOVERY MODE
          MX0    -2
          BX7    -X0*X1
          SA7    CIRA        SET RECOVERY MODE
          SA2    MCE
          ZR     X2,SSP5.1   IF MEMORY CLEARING NOT ENABLED
          SA7    /MCE/PRSA   SET RECOVERY LEVEL
 SSP5.1   SA2    MSAP        SET DEVICE SELECTION ADDRESS
          AX2    36
          BX6    X2
          SA6    MSA
          SA2    MABL        CHECK MAINFRAME TYPE
          MX3    2
          LX2    59-46
          BX2    X3*X2
          BX2    X2-X3
          NZ     X2,SSP6     IF NOT CYBER 176 MAINFRAME
          SX6    EEMC+60B-1  SET XP FLAG AND EXIT MODE FOR CYBER 176
          SA6    XPFE
          SA2    EST         LOCATE CYBER 176 EXCHANGE PACKAGE AREA
          SA3    ESTL
          CX6    X3,EST      LWA+1 OF EST
          IX2    X2+X6
          MX0    4
          SX2    X2+777B
          LX0    4+9
          BX6    X0*X2
          SX7    X6+/MONITOR/EEA-/MONITOR/MCU
          SA6    EXPA
          SA7    EEAD
 SSP6     SA1    MMFL
          LX1    15
          AX1    60-9
          ZR     X1,SSP7     IF NOT MMF CONFIGURATION
          RJ     ILD         INITIALIZE LINK DEVICE
          NZ     B6,SSP7     IF ERROR FOUND
          SA1    SFES        DECREASE ECS TRANSFER RATE BY 1/2
          SX6    X1+B1
          SA6    A1
          MX0    -12
          SA1    MMFL        SET MMF PARAMETERS
          BX6    -X0*X1
          MX4    -MXMF
          LX1    -12
          SA6    MIN         SET MACHINE INDEX
          BX7    -X4*X1
          LX2    X6,B1       SET MST INTERLOCKS
          LX6    6
          SA6    MRT         SET MRT ADDRESS
          SA7    MMK         SET MACHINE MASK
          SX7    X2+B1
          SA7    MIL
          LX1    -36
          BX7    -X0*X1
          SA7    MID         SET MACHINE ID
          BX1    X6          COMPUTE MST LOCAL AREA OFFSET
          AX6    1
          IX6    X1+X6
          AX6    4
          SA6    MSL
 SSP7     SA1    EIBP        SET FWA OF *EICB*
          SX6    X1
          SA6    DSCB
          ZR     X6,SSP7.9   IF NO *EICB*
          RT     X1,/DST/EICB  TELL *EI* WHERE THE *EICB* IS
          SX7    SVNL        SET SYSTEM VERSION NAME POINTER IN *EICB*
          SA7    X6+/DST/D7SV+2
          SX7    SYTL        SET SYSTEM TITLE LINE POINTER IN *EICB*
          SA7    X6+/DST/D7SV+3
          LX1    59-58
          PL     X1,SSP7.1   IF NOT DUAL CPU MACHINE WITH CACHE
          SX6    B1
          BX7    X7-X7
          SA6    DCPC        SET DUAL CPU MACHINE WITH CACHE FLAGS
          SA7    NDCPC
 SSP7.1   SA1    SSTL
          LX1    59-44
          NG     X1,SSP7.2   IF HARDWARE FAULT INJECTION IS DISABLED
          SA1    X6+/DST/D7JP  SET *V1*, *V2* AND *V3* BITS IN *EICB*
          MX6    3
          LX6    16-57
          BX6    X1+X6
          SA6    A1
 SSP7.2   SA1    SSCT
          SX6    X1-1
          SX1    NVSI-MXSI-1
 SSP7.3   SX1    X1+5
          SX6    X6+1
          NG     X1,SSP7.3   IF NOT TO *NVE* ENTRY WORD YET
          SA6    NVESS       ADDRESS OF WORD WITH *NVE* ENTRY
          LX1    2
          LX6    X1,B1
          IX1    X1+X6
          SX6    48
          IX6    X6-X1
          SA6    NVEOS       SHIFT COUNT GETS *NVE* ENTRY IN BITS 59-48
          EQ     SSP7.9      CHECK FOR BUFFERED I/O
 IBO      SPACE  4,10
**        IBO - INITIALIZE FOR BUFFERED I/O.
*
*         ENTRY  (CIRA) = RECOVERY LEVEL.
*
*         CALLS  RBT.
 
 
 IBO21    RJ     RBT         RECOVER BUFFERED I/O TABLES
 
 IBO      PS                 ENTRY/EXIT
          SA1    BIOL
          AX1    24
          SX1    X1
          ZR     X1,IBO      IF NO BUFFERED I/O
          SA1    CIRA        GET RECOVERY LEVEL
          SX1    X1-3
          ZR     X1,IBO21    IF CM RECOVERY
          TA3    NOPE*ESTE-1*ESTE,EST
          SB2    NOPE-1      INITIALIZE EQUIPMENT INDEX
          SA5    IBOP
          SB7    A0          SAVE (A0)
          SB6    X5
          TNO    /PRESET/IBO2,IHPFMD  IF NO 819 DEVICES
          SX6    100B        INITIALIZE CCT FOR 819-S
          SX4    202B
          LX6    36
          LX4    36
          TA6    CCNT,CCT    SET UP CCT
          SB3    NCCT-1
 IBO1     IX6    X6+X4
          SB3    B3-B1
          SA6    A6+CCTL
          NZ     B3,IBO1     IF NOT COMPLETE
          TX6    NCCT*CCTL,CCT
          SA6    IBOD        SET NEW LWA+1 OF *CCT*
 
 IBO2     SA5    IBOA-1
          SX0    7777B
 IBO3     SA3    A3+ESTE     CHECK NEXT EST ENTRY
          SB2    B2+B1
          BX4    X0*X3
          EQ     B2,B6,IBO15 IF END OF EST
          PL     X3,IBO3     IF NOT MASS STORAGE DEVICE
          LX4    3
          SA1    X4+DILL     FETCH DRIVER WORD FROM MST
          LX1    59-22
          PL     X1,IBO3     IF NOT BUFFERED DEVICE
          MX0    -11
          LX3    -12
 IBO4     SA5    A5+B1
          ZR     X5,IBO2     IF END OF TABLE (NOT BUFFERED DEVICE)
          BX6    X5-X3
          BX6    -X0*X6
          NZ     X6,IBO4     IF NO DEVICE MATCH
          BX6    -X0*X3
          BX7    X5
          SA6    IBOK        DEVICE CODE
          MX2    -6
          LX1    22-59
          SA7    IBOQ        SAVE DRIVER NAME
          BX6    -X2*X1      ALGORITHM INDEX
          SX2    X6-AIAB
          NG     X2,IBO4.1   IF NOT DAS DEVICE
          SX2    X6-AIAE
          PL     X2,IBO4.1   IF NOT DAS DEVICE
          SA2    A1+STLL-DILL
          PL     X2,IBO4.1   IF FORMAT NOT PENDING
          SX6    B0+
 IBO4.1   SA6    IBOF        SET DAS FORMAT PENDING FLAG
          SA2    A1+DDLL-DILL
          MX6    -3
          BX7    X2
          LX2    -48
          BX6    -X6*X2      NUMBER OF UNITS - 1
          SX6    X6+B1
          LX3    12-24
          SA7    IBOG        UNIT LIST
          LX2    -6
          MX7    -3
          BX7    -X7*X2
          SA7    IBOR        EQUIPMENT (CONTROLLER) NUMBER
          BX1    -X0*X3
          LX3    24-36
          SA6    IBOH        NUMBER OF UNITS
          BX3    -X0*X3
          LX1    12
          SA2    A5+IBOS-IBOA  SET READ AHEAD PARAMETERS
          BX6    X1+X3
          SA6    IBOM        CHANNEL LIST
          LX7    X2
          SA2    A1+BDLL-DILL
          MX6    -30
          LX6    18
          BX2    -X6*X2
          BX7    X2+X7
          SA1    A1+         *DILL* WORD OF CURRENT MST
          SA7    A2
          MX0    -12
          LX1    -24
          BX7    -X0*X1      PRIOR PARTITION EST ORDINAL
          SA7    IBOT        FLAG WHETHER *PUT* PREVIOUSLY ESTABLISHED
          ZR     X7,IBO5     IF NO PRIOR PARTITION
          BX1    X0*X1       CLEAR ORDINAL FIELD
          CX3    X7,EST      CONVERT EST ORDINAL TO OFFSET
          TA2    X3+EQDE,EST GET PRIOR PARTITION EST ENTRY
          BX2    -X0*X2
          LX2    3           PRIOR PARTITION MST ADDRESS
          SA2    X2+DILL     *DILL* WORD OF PRIOR PARTITION MST
          LX2    -24
          BX2    -X0*X2      *PUT* ORDINAL FROM PRIOR PARTITION MST
          BX7    X1+X2       MERGE AND STORE *PUT* ORDINAL
          LX7    24
          SA7    A1+
 IBO5     SA2    IBOH        NUMBER OF UNITS
          ZR     X2,IBO2     IF NO MORE UNITS
          SX6    X2-1
          SA6    A2
          SB3    B0          PRESET NO CHANNELS PROCESSED
          SA2    IBOM        SET CHANNELS FOR UNIT PROCESSING
          SA1    IBOT
          BX6    X2
          SA6    IBOI
          NZ     X1,IBO8     IF *PUT*(S) ALREADY ESTABLISHED
          SA1    IBOB        NEXT AVAILABLE PUT ENTRY
          SX6    X1+PUTL
          SA6    A1+
          SA2    IBOG        UNIT LIST
          MX6    -6
          BX6    -X6*X2      NEXT UNIT
          SA6    IBOL        UNIT NUMBER
          AX2    6
          BX7    X2
          SA7    A2
          SX2    B2          EST ORDINAL
          LX6    48
          LX2    36
          SA4    IBOR        EQUIPMENT (CONTROLLER) NUMBER
          BX6    X2+X6
          LX4    54
          BX6    X4+X6
          MX0    -6
          SA6    X1+UNCT     UNIT CONTROL WORD OF *PUT*
          SA2    IBOF
          NZ     X2,IBO5.1   IF NOT DAS DEVICE WITH FORMAT PENDING
          MX7    1
          LX7    16-59
          SA7    X1+PILL     SET *FORMAT* SPECIAL REQUEST FLAG
 IBO5.1   SA1    IBOQ        NUMBER OF PARTITIONS AND SECTORS/BUFFER
          SA2    IBOC        FWA OF NEXT AVAILABLE HAT ENTRY
          MX3    6
          LX1    42
          SX4    HATLE
          BX3    X3*X1       PHYSICAL SECTORS PER I/O BUFFER
          BX1    -X0*X1      NUMBER OF PARTITIONS
          IX6    X1*X4       *HAT* SPACE FOR ALL PARTITIONS OF DEVICE
          IX7    X2+X6
          LX2    24
          SA7    A2          NEXT FWA OF NEXT AVAILABLE HAT
          SX6    B1
          BX2    X3+X2
          IX6    X4-X6       HASHING MASK
          LX6    42
          BX6    X6+X2
          SA6    A6+HSCT-UNCT  HASH TABLE CONTROL
          TX7    A6-HSCT,-PUT  COMPUTE PUT ORDINAL
          AX7    PUTLS
          SA3    A3          EST ENTRY
          MX6    -12
          BX3    -X6*X3
          LX3    3           MST ADDRESS
          SA1    X3+DILL     *PUT* ORDINAL OF FIRST UNIT IN CHAIN
          LX1    -24
          BX5    -X6*X1
          NZ     X5,IBO6     IF MORE UNITS IN CHAIN
          BX7    X7+X1       SET *PUT* ORDINAL IN MST FOR FIRST UNIT
          LX7    24
          SA7    A1
          EQ     IBO8        PROCESS CHANNELS
 
 IBO6     LX5    PUTLS
          TA1    X5+HSCT,PUT  CHECK NEXT *PUT* IN CHAIN
          BX5    -X6*X1
          NZ     X5,IBO6     IF NOT END OF CHAIN
          BX7    X7+X1       SET CURRENT *PUT* ORDINAL
          SA7    A1
 
*         PROCESS CHANNELS.
 
 IBO8     SA2    IBOI
          MX0    -6
          BX1    -X0*X2      EXTRACT ONE CHANNEL
          BX7    X2
          AX7    12          REMOVE CHANNEL FROM LIST
          SA7    IBOI
          ZR     B3,IBO9     IF NO CHANNELS PROCESSED
          ZR     X2,IBO5     IF NO CHANNEL PRESENT
 IBO9     SA2    IBOD        FWA OF NEXT AVAILABLE *CCT*
          TX3    CCT         FWA OF *CCT*
 IBO10    BX6    X2-X3
          ZR     X6,IBO11    IF END OF CURRENT CCT-S
          SA4    X3+CCNT
          LX4    -36
          BX7    -X0*X4
          BX6    X1-X7
          ZR     X6,IBO12    IF CHANNEL MATCH
          SX3    X3+CCTL     ADVANCE *CCT* ADDRESS
          TNO    /PRESET/IBO10,IHPFMD  IF NO 819 DEVICES
          LX4    -6
          BX7    -X0*X4
          BX6    X1-X7
          ZR     X6,IBO12    IF CHANNEL MATCH
          EQ     IBO10       CONTINUE SEARCH
 
 IBO11    BX7    X1          CHANNEL
          LX7    36
          SA7    X2+CCNT     CREATE NEW *CCT* ENTRY
          SX7    X2+CCTL     ADVANCE CCT ADDRESS
          SA7    A2
          SA2    IBOQ        DRIVER PP NAME(S)
          SX7    40B
          BX7    X7*X1
          ZR     X7,IBO11.1  IF NOT A CONCURRENT CHANNEL
          LX2    18          SET FOR CONCURRENT PP DRIVER
 IBO11.1  AX2    42          REMOVE ALL BUT PP NAME
          LX2    42          (CODE ASSUMES VALID PP NAME)
          BX7    X2+X1       MERGE PP NAME AND CHANNEL NUMBER
          TX2    X3,-CCT
          LX2    30-CCTLS    *CCT* ORDINAL
          BX7    X7+X2
          SA7    X3+CUN1
 IBO12    SB3    B3+B1       ADVANCE CHANNEL PROCESSED
          TNO    /PRESET/IBO14,IHPFMD  IF NO 819 DEVICES
          SA2    IBOL        UNIT NUMBER
          TX7    A6-HSCT,-PUT
          AX7    PUTLS       *PUT* ORDINAL
          SX1    12          COMPUTE BYTE POSITION
          IX1    X1*X2
          SB4    X1
          SB5    B4-4*12
          NG     B5,IBO13    IF UNITS 0 - 3
          SB4    B5
          SX3    X3+CUN2-CUN1
 IBO13    SA1    X3+CUN1
          LX7    B4          POSITION PUT ORDINAL
          BX7    X7+X1
          SA7    A1
 IBO14    LE     B3,B1,IBO8  IF BOTH CHANNELS NOT PROCESSED
          EQ     IBO5        PROCESS NEXT UNIT
 
*         INITIALIZE CONTROL BUFFERS.
 
 IBO15    SA0    IBOE        READ IBDT
          TX0    ETLT*100B+IBDT,ECLT
          TX0    X0,TCNT
          SX1    A0
          LX1    30
          BX0    X0+X1
          RE     MXMF
+         SA1    A0-B1
          SA2    MMFL
          MX0    12
          SB2    MXMF
 IBO16    SA1    A1+B1       SEARCH FOR ID
          BX3    X1-X2
          BX3    X0*X3
          ZR     X3,IBO17    IF ID MATCH
          SB2    B2-B1
          NZ     B2,IBO16    IF NOT END OF IBDT
          EQ     *           HANG - ID NOT FOUND
 
 IBO17    MX0    -12
          LX1    -12
          BX7    -X0*X1      FWA OF I/O BUFFERS
          TLX7   9,TNSC
          SB6    B1
          SX3    PSLB
          LX3    9
          TB2    1,NIOB
          SB3    IOLK+CBTL
 IBO18    TA7    B3,CBT      I/O BUFFER ADDRESS
          SX6    B1
          LX6    21
          SA6    A7+HSLK-IOLK  LIST INDEX
          IX7    X7+X3       INCREMENT I/O BUFFER ADDRESS
          SX0    B6-B1
          SB6    B6+B1
          SX6    B6
          LX0    36
          LX6    24
          BX6    X6+X0
          SA6    A6+LSLK-HSLK  CONTROL BUFFER LINK(S)
          SB3    B3+CBTL     NEXT BUFFER
          LT     B6,B2,IBO18 IF MORE BUFFERS
          AX6    36
          LX6    36
          SA6    A6          CLEAR LAST LINK ON LIST
          SX7    B6-B1
          SX2    B1
          LX7    18
          BX2    X7+X2
          LX7    18
          BX7    X2+X7
          TA7    EMTB        SET EMPTY LIST CONTROL WORD
          SA0    B7          RESTORE (A0)
 
*         PROCESS SYSTEM DEVICE(S).
 
          MX0    -12         SET UP SYSTEM DEVICE TABLES
          SB3    B0
          SX7    NOPE        INITIALIZE EST ORDINAL FOR SEARCH
 IBO19    CX1    X7,EST      CONVERT EST ORDINAL TO OFFSET
          TA1    X1+EQDE,EST READ EST ENTRY
          PL     X1,IBO20    IF NOT MASS STORAGE DEVICE
          BX2    X1
          LX1    59-58
          PL     X1,IBO20    IF NOT SYSTEM DEVICE
          SA7    /BUFIO/RDBA+B3  SET EST ORDINAL IN TABLE
          BX6    -X0*X2
          LX6    3
          SX6    X6+DALL
          SA6    /BUFIO/RDBB+B3
          SB3    B3+1        ADVANCE INDEX
 IBO20    SX7    X7+B1       ADVANCE EST ORDINAL
          SA1    IBOP
          IX1    X7-X1
          NG     X1,IBO19    IF NOT END OF MASS STORAGE DEVICES
          SX7    B0+
          SA7    /BUFIO/RDBB+B3   TERMINATE TABLE
          GT     B3,B1,IBO   IF MORE THAN ONE SYSTEM DEVICE
          SA1    IBOO
          BX6    X1
          SA6    /BUFIO/RDB14
          EQ     IBO         RETURN
 TBLM     SPACE  4,10
**        TBLM - GENERATE TABLE OF BUFFERED I/O PARAMETERS.
 
 
          PURGMAC TBLM
 TBLM     MACRO  EQ
 .A       IFGE   AI_EQ,AIBB
 .B       IFLT   AI_EQ,AIBD
          VFD   18/3R"NPP_EQ",18/3R"CPP_EQ",6/PNUN_EQ,6/PSBF_EQ,12/2R_EQ
 IBOS     RMT
          VFD    42/0,6/BCT_EQ,6/RAT_EQ,6/RBT_EQ
 IBOS     RMT
 .B       ENDIF
 .A       ENDIF
          ENDM
 
**        BUFFERED I/O DEVICE SUPPORT TABLE *IBOA*.
*
*T,IBOA   18/ NPP, 18/ CPP, 6/ PUN, 6/ SS, 12/ DM
*
*
*         NPP    NIO PP DRIVER NAME.
*         CPP    CIO PP DRIVER NAME.
*         PUN    PARTITIONS PER PHYSICAL DEVICE.
*         SS     PHYSICAL SECTOR SIZE RELATIVE TO I/O BUFFER SIZE.
*         DM     DEVICE MNEMONIC.
 
 IBOA     BSS    0
 
          LIST   G
          TBL    "MSEQ"
          CON    0
 
**        BUFFERED I/O DEVICE SUPPORT TABLE *IBOS*.
*
*T,IBOS   42/ , 6/ BC, 6/ RT, 6/ RB
*
*
*         BC     DEFAULT BUFFER COUNT.
*         RT     READ-AHEAD THRESHOLD (NTH BUFFER IN).
*         RB     DEFAULT READ BUFFER THRESHOLD.
*
*         NOTE - TABLE *IBOS* PARALLELS TABLE *IBOA*.
 
 IBOS     BSS    0
 
 IBOS     HERE
          LIST   *
          PURGMAC TBLM
 
 IBOB     TVFD   60/PUTL,PUT CURRENT LWA+1 OF *PUT*
 IBOC     TVFD   60/0,HAT    CURRENT LWA+1 OF *HAT*
 IBOD     TVFD   60/0,CCT    CURRENT LWA+1 OF *CCT*
 IBOE     BSS    MXMF        *IBDT* BUFFER
 IBOF     CON    1           ZERO IF 583X DEVICE WITH FORMAT PENDING
 IBOG     CON    0           UNIT LIST
 IBOH     CON    0           NUMBER OF UNITS
 IBOI     CON    0           CHANNELS (DURING UNIT PROCESSING)
 IBOK     CON    0           DEVICE TYPE (CODE)
 IBOL     CON    0           UNIT NUMBER
 IBOM     CON    0           CHANNELS
 IBOO     SB0    0           NO OPERATION(S)
          SB0    0
 IBOP     CON    0           LAST MASS STORAGE ORDINAL + 1 (*SSP*)
 IBOQ     CON    0           SAVE AREA FOR BUFFERED I/O DRIVER NAME
 IBOR     CON    0           EQUIPMENT (CONTROLLER) NUMBER
 IBOT     CON    0           ZERO IF *PUT* NOT ALREADY ESTABLISHED
 RBS      SPACE  4,10
**        RBS - RECOVER BUFFER STATUS TABLES.
*
*         EXIT   READ ONLY ACCESS AND *MTE* REQUEST FLAGS CLEARED.
*
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 1, 3, 7.
*                B - 2, 3, 4.
 
 
 RBS      PS                 ENTRY/EXIT
          SA1    BIOMMF
          ZR     X1,RBS      IF NO SHARED DEVICES PRESENT
          SA1    IBOP
          SB2    NOPE-1
          SB3    X1+         LAST MASS STORAGE ORDINAL + 1
 RBS1     SB2    B2+B1
          EQ     B2,B3,RBS   IF ALL MASS STORAGE EQUIPMENTS CHECKED
          SX1    B2
          CX2    X1,EST
          TA1    X2+EQDE,EST
          MX0    -12
          SX7    5040B
          BX2    -X0*X1
          LX1    12
          BX1    X7*X1
          IX1    X1-X7
          NZ     X1,RBS1     IF NOT SHARED BUFFERED MASS STORAGE DEVICE
          LX2    3           SET MST ADDRESS
          SA1    X2+BDLL     GET BST POINTER
          LX1    -24
          SA3    RBSA        GET WRITE ACCESS MASK
          SA1    X1-1
          SB4    BSTL
 RBS2     SA1    A1+B1       GET BST WORD
          SB4    B4-B1
          ZR     B4,RBS1     IF END OF BST
          BX6    X3*X1
          BX7    X3*X1       PRESERVE WRITE ACCESS
          LX6    -1
          BX7    X7+X6       SET READ ACCESS WITH WRITE ACCESS
          SA7    A1          UPDATE BST
          EQ     RBS2        PROCESS NEXT BST WORD
 
 
 RBSA     DATA   44444444444444440000B
 RBT      SPACE  4,10
**        RBT - RECOVER BUFFERED I/O TABLES.
*
*         EXIT   (EFRL) = 2000B  IF ERROR FOUND DURING RECOVERY.
*
*         CALLS  RBS, RCB, VUQ, VWL.
 
 
 RBT9     SA1    EFRL        SET ABORT FLAG
          SX6    2000B
          BX6    X6+X1
          SA6    A1
 
 RBT      PS                 ENTRY/EXIT
          TA1    IBSP,BDT    INITIALIZE TABLE ADDRESS
 RBT1     SA2    A1+B1       READ NEXT ENTRY
          MX3    6
          LX3    18-54
          BX6    -X3*X1      CLEAR INTERLOCKS
          SA6    A1
          MX7    12
          BX6    X7*X1       NUMBER OF ENTRIES IN CURRENT TABLE (NE)
          MX7    -6
          LX1    18
          LX6    12
          TB3    A1-PUTP,-BDT
          ZR     B3,RBT2     IF *PUT* POINTER
          SB3    B3+PUTP-FTTP
          ZR     B3,RBT2     IF *FTT* POINTER
          SB3    B3+FTTP-CBTP
 RBT2     NZ     B3,RBT3     IF NOT *CBT* POINTER
          SX6    X6+1
 RBT3     BX5    -X7*X1      LENGTH OF ENTRY (LE)
          LX1    18
          MX7    -18
          IX3    X6*X5       NE*LE
          BX4    -X7*X1      TABLE LENGTH (LT)
          IX3    X4-X3
          NZ     X3,RBT9     IF (NE*LE) .NE. (LT)
          TB3    A1-CBTP,-BDT
          ZR     B3,RBT4     IF LAST ENTRY IN TABLE
          LX1    24
          BX3    -X7*X2      FWA OF NEXT TABLE
          BX5    -X7*X1      FWA OF CURRENT TABLE
          IX6    X5+X4       FWA + LT
          BX7    X6-X3
          NZ     X7,RBT9     IF (FWA+LT) .NE. (NEXT FWA)
          SA1    A2
          EQ     RBT1        LOOP
 
 RBT4     RJ     VUQ         VALIDATE UNIT I/O QUEUES
          RJ     VWL         VALIDATE WRITE LIST
          RJ     RCB         RECOVER CBT
          NZ     X6,RBT9     IF ERROR FOUND
          RJ     RBS         RECOVER BUFFER STATUS TABLES
 
*         CLEAN UP CHANNEL CONTROL TABLE(S).
 
          TA1    CCTP,BDT    GET TABLE DESCRIPTOR
          LX1    -24
          SB2    X1          LENGTH OF TABLE
          SB3    B0          INITIALIZE INDEX
          MX0    -48
          SX6    B0
 RBT5     TA6    B3+CREQ,CCT CLEAR ENTRY
          TA1    B3+CCNT,CCT
          BX7    -X0*X1
          SA7    A1
          SB3    B3+CCTL     INCREMENT INDEX
          LT     B3,B2,RBT5  IF NOT END OF TABLE
 
*         CLEAN UP PHYSICAL UNIT AND FUNCTION TIMEOUT TABLES.
 
          TA1    PUTP,BDT    GET TABLE DESCRIPTOR
          LX1    -24
          SB2    X1          LENGTH OF TABLE
          SB3    PUTL        INITIALIZE INDEX
          MX0    -54
          TNO    RBT5.1,IH819  CLEAR READ RECOVERY INDEX FOR 819-S
          MX0    -57         PRESERVE EQUIPMENT NUMBER FOR 9853/*DAS*
 RBT5.1   MX2    27
          MX3    18
          LX2    24+27
          LX3    12+0
          BX2    X2+X3
          BX7    X7-X7
 RBT6     TA1    B3+UNCT,PUT CLEAR INTERLOCK AND FLAGS
          SX4    B3
          BX6    -X0*X1
          TA3    B3+HSCT,PUT
          AX4    PUTLS-FTTLS
          SA6    A1
          TA7    X4,FTT      CLEAR FTT ENTRY
          BX6    X2*X3
          SA6    A3
          SB3    B3+PUTL     INCREMENT INDEX
          LT     B3,B2,RBT6  IF NOT END OF TABLE
 
*         CLEAN UP PLT.
 
          SB2    PLTL        LENGTH OF TABLE
          SB3    B0+         INITIALIZE INDEX
          SX7    B0+
          SX6    B0+
 RBT8     TA7    B3,PLT      CLEAR TABLE
          TA6    B3+1,PLT
          SB3    B3+2
          LT     B3,B2,RBT8  IF NOT END OF TABLE
          EQ     RBT         RETURN
 RCB      SPACE  4,15
**        RCB - RECOVER CBT.
*
*         EXIT   (X6) = 0 IF NO ERROR.
*                (X6) .NE. 0 IF ERROR DETECTED.
*                BUFFER INTERLOCKS CLEARED.
*                I/0 ACTIVITY FLAGS AND UNIT QUEUE LINKAGE CLEARED.
*                READ BUFFERS DROPPED AND LINKED TO EMPTY LIST.
*                WRITE BUFFERS LINKED TO WRITE LIST.
*
*         USES   X - ALL.
*                A - 0, 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 6, 7.
*
*         CALLS  /BUFIO/DCH, /BUFIO/LCC.
 
 
 RCB9     SX6    1           SET ERROR STATUS
 
 RCB      PS                 ENTRY/EXIT
 
*         CLEAN UP BUFFER MANAGER LIST POINTERS.
 
          SX6    B0+
          TA6    EMTB        CLEAR EMPTY LIST POINTER
          TA6    DWTB        CLEAR DATA WRITTEN LIST POINTER
          TA6    DRDB        CLEAR READ LIST POINTER
          TA6    WRTB        CLEAR WRITE LIST POINTER
 
*         DETERMINE BASE ADDRESS OF DATA BUFFERS.
 
          SB7    A0+         SAVE (A0)
          SA0    IBOE        CM BUFFER
          TX0    ETLT*100B+IBDT,ECLT
          TX0    X0,TCNT     *IBDT* ADDRESS
          SX1    A0
          LX1    30
          BX0    X0+X1
          RE     MXMF        READ *IBDT*
          EQ     RCB9        RETURN ERROR ON HALF-EXIT
 
          SA3    A0-B1
          SA4    MMFL        GET MACHINE ID
          MX0    12
          SB2    MXMF        LENGTH OF *IBDT*
          SA0    B7          RESTORE (A0)
 RCB1     SA3    A3+1        NEXT ENTRY
          BX5    X3-X4       CHECK MACHINE ID
          BX5    X0*X5
          ZR     X5,RCB2     IF THIS MACHINE
          SB2    B2-1
          NZ     B2,RCB1     IF NOT END OF TABLE
          EQ     RCB9        RETURN ERROR
 
 RCB2     MX0    -12
          LX3    -12
          BX7    -X0*X3
          TLX7   9,TNSC      FWA OF I/O BUFFERS
          SB3    RCBA        SET REGISTER SAVE BUFFER ADDRESS
          SX1    LSLB*100B
          SX0    B0+         INITIALIZE BUFFER ORDINAL
          IX7    X7-X1       INITIALIZE BUFER ADDRESS
 
*         CHECK NEXT BUFFER.
 
 RCB3     SX1    LSLB*100B
          SX0    X0+B1       ADVANCE CBT ORDINAL
          IX7    X7+X1       ADVANCE DATA BUFFER ADDRESS
          BX5    X0
          TX6    X0-1,-NIOB
          LX5    CBTLS       SET CBT OFFSET
          ZR     X6,RCB      IF ALL BUFFERS PROCESSED
          TA1    X5+IOLK,CBT
          TA2    X5+HSLK,CBT
          SX6    B0+
          TA6    X5+LSLK,CBT CLEAR LIST LINKAGE AND FLAGS
          MX6    -48
          LX1    59-57
          BX6    -X6*X2      CLEAR *HSLK* FLAGS
          SA6    A2
          PL     X1,RCB5     IF NO WRITE DATA IN BUFFER
 
*         PROCESS WRITE BUFFER.
 
          LX1    59-54-59+57
          NG     X1,RCB4     IF RECOVERED FLAG SET
          SA2    REML        SET ERROR FLAG
          SX6    WLNL        *NON-LINKED WRITE BUFFER.*
          BX6    X6+X2
          SA6    A2
 RCB4     LX1    54-54-59+54 RESTORE *IOLK*
          MX3    -24
          BX3    -X3*X1      DATA BUFFER ADDRESS
          BX3    X3-X7
          NZ     X3,RCB9     IF DATA BUFFER ADDRESS INCORRECT
          SX6    B1
          LX6    57-0
          BX6    X6+X7       SET WRITE FLAG AND BUFFER ADDRESS
          SA6    A1          UPDATE *IOLK*
          TX1    WRTB        SET WRITE LIST
          EQ     RCB8        LINK BUFFER TO WRITE LIST
 
*         PROCESS READ BUFFER.
 
 RCB5     LX1    59-54-59+57
          PL     X1,RCB6     IF RECOVERED FLAG NOT SET
          SA2    REML        SET RECOVERY ERROR
          SX6    WLRD        *READ DATA ON WRITE LIST.*
          BX6    X2+X6
          SA6    A2
 RCB6     SX6    B0
          TA6    X5+PAD1,CBT CLEAN UP BUFFER
          SA6    A6+B1
          ERRNZ  PAD2-PAD1-1
          SA6    A6+B1
          ERRNZ  PAD3-PAD2-1
          SA6    A6+B1
          ERRNZ  PAD4-PAD3-1
          TA7    X5+IOLK,CBT SET BUFFER ADDRESS
          SB6    RCB7        SET *DCH* RETURN ADDRESS
          EQ     /BUFIO/DCH  DELINK BUFFER FROM HASH LIST
 
 RCB7     TX1    EMTB        SET EMPTY LIST
 
*         LINK BUFFER TO WRITE OR EMPTY LIST.
 
 RCB8     SB6    RCB3        SET *LCC* RETURN ADDRESS
          EQ     /BUFIO/LCC  SET LIST LINKAGE
 
 
 RCBA     BSS    2           REGISTER SAVE BUFFER
 VUQ      SPACE  4,10
**        VUQ - VALIDATE UNIT I/O QUEUE(S).
 
 
 VUQ      PS                 ENTRY/EXIT
          SA1    REML        CLEAR PREVIOUS ERRORS
          MX7    48
          BX7    X7*X1
          SA7    A1
 
*         SCAN PUT(S), DELETING READ REQUEST(S) FROM QUEUE(S).
 
          TA1    PUTP,BDT    TABLE DESCRIPTOR
          LX1    -24
          SB2    X1          LENGTH OF TABLE(S)
          SB6    PUTL        INITIALIZE INDEX
          MX6    -12
 VUQ1     TA2    B6+UNCT,PUT READ QUEUE CONTROL
          BX7    X7-X7
          SA7    A2+PILL-UNCT  CLEAR PREVIOUS ERRORS, INTERLOCK, FLAGS
          MX7    24          CLEAR I/O QUEUE
          BX7    X7*X2
          SA7    A2
          LX2    -24
          BX3    -X6*X2
          LX2    24
          BX0    -X6*X2      FIRST
          LX0    CBTLS
          NZ     X3,VUQ1.1   IF QUEUE SIZE .NE. 0
 
*         QUEUE SIZE IS ZERO - VERIFY IT IS EMPTY.
 
          MX3    -24
          BX2    -X3*X2
          ZR     X2,VUQ6     IF FIRST AND CURRENT .EQ. 0
          SA3    A2+PILL-UNCT  SET ERROR FLAG
          SX7    IOQS        *I/O QUEUE SIZE.*
          LX7    48
          BX7    X7+X3
          SA7    A3
 VUQ1.1   ZR     X0,VUQ      IF FIRST .EQ. 0
          TA3    X0+IOLK,CBT
          LX3    -36
          BX2    -X6*X3
          NZ     X2,VUQ8     IF BACKWARD LINK OF FIRST BUFFER .NE. 0
 VUQ2     TA3    X0+IOLK,CBT READ BUFFER
          LX3    -24
          BX7    X0
          BX0    -X6*X3      NEXT BUFFER
          ZR     X0,VUQ3     IF END OF QUEUE
          AX7    CBTLS
          LX0    CBTLS
          TA4    X0+IOLK,CBT CHECK BACKWARD LINK OF NEXT BUFFER
          LX4    -36
          BX4    -X6*X4
          BX2    X4-X7
          NZ     X2,VUQ8     IF BACKWARD LINK NOT CORRECT
 VUQ3     LX3    59-57+24
          PL     X3,VUQ5     IF NOT WRITE DATA IN BUFFER
 
*         WRITE DATA FOUND IN BUFFER.
 
          SA4    A3+HSLK-IOLK  GET *PUT* ORDINAL
          SX5    B6
          BX4    -X6*X4
          AX5    PUTLS
          BX4    X5-X4
          NZ     X4,VUQ10    IF PUT ORDINAL INCORRECT
          LX3    59-54-59+57
          NG     X3,VUQ8     IF RECOVERED FLAG ALREADY SET
          MX7    1
          BX7    X3+X7       SET RECOVERED FLAG
          LX7    54-59
          PL     X7,VUQ8     IF I/O INTERLOCK NOT SET
          SA7    A3
 VUQ5     MX6    -12
          NZ     X0,VUQ2     IF NOT END OF QUEUE
 VUQ6     SB6    B6+PUTL     INCREMENT *PUT* INDEX
          LT     B6,B2,VUQ1  IF NOT END OF *PUT*-S
          EQ     VUQ         RETURN
 
 
 VUQ8     SX7    IOQL        * I/O QUEUE LINKAGE.*
 VUQ9     LX7    48
          SA3    A2+PILL-UNCT  SET ERROR FLAG
          BX7    X7+X3
          SA7    A3
          EQ     VUQ6        CHECK NEXT *PUT*
 
 VUQ10    SX7    IOQP        * I/O QUEUE *PUT* ORDINAL.*
          EQ     VUQ9        CONTINUE
 VWL      SPACE  4,10
**        VWL - VALIDATE WRITE LIST.
 
 
 VWL7     SA1    REML        SET ERROR FLAG
          BX7    X7+X1
          SA7    A1
 
 VWL      PS                 ENTRY/EXIT
          TA2    WRTB        WRITE LIST POINTER(S)
          LX2    -36
          SB2    X2          BUFFER COUNT
          ZR     B2,VWL      IF NO WRITE BUFFERS
          TA1    WRTB
          SX3    X1          FIRST
          SB4    B0          PRESET BUFFER COUNT
          SX5    B0          PRESET BACKWARD LINK
          MX0    -12
          ZR     X3,VWL3     IF FIRST BUFFER .EQ. 0
 VWL1     LX3    CBTLS
          TA3    X3+LSLK,CBT READ BUFFER
          LX3    -36
          BX4    -X0*X3
          BX5    X5-X4
          NZ     X5,VWL3     IF BACKWARD LINK INCORRECT
          SA5    A3+IOLK-LSLK
          LX5    59-54
          NG     X5,VWL3     IF RECOVERED FLAG ALREADY SET
          MX7    1
          BX7    X5+X7       SET RECOVERED FLAG
          LX7    59-57-59+54
          PL     X7,VWL4     IF NOT WRITE DATA
          LX7    57-59
          NG     X7,VWL5     IF I/O INTERLOCK SET
          SA7    A5
          SB4    B4+B1       COUNT BUFFER
          LX3    12
          BX3    -X0*X3
          TX5    A5-IOLK,-CBT
          AX5    CBTLS
          NZ     X3,VWL1     IF FORWARD LINK .NE. 0
          NE     B4,B2,VWL6  IF COUNT NOT CORRECT
          LX1    -18
          SX1    X1
          BX5    X1-X5
          ZR     X5,VWL      IF LAST POINTER CORRECT
 
 VWL3     SX7    WLLE        * WRITE LIST LINKAGE.*
          EQ     VWL7        CONTINUE
 
 VWL4     SX7    WLRD        * READ DATA ON WRITE LIST.*
          EQ     VWL7        CONTINUE
 
 VWL5     SX7    WLIB        * INTERLOCKED BUFFER ON WRITE LIST.*
          EQ     VWL7        CONTINUE
 
 VWL6     SX7    WLBC        * WRITE LIST BUFFER COUNT.*
          EQ     VWL7        CONTINUE
 
 CIR      SPACE  4
**        CIR - CLEAR INTERLOCKS.
 
 
 CIRX     SA0    B3+         RESTORE (A0)
 CIR      PS                 ENTRY/EXIT
          SA1    CIRA        CHECK RECOVERY MODE
          SB2    1000B       INTERLOCK RETRY COUNT
          SX1    X1-3
          NZ     X1,CIR      IF NOT LEVEL THREE RECOVERY
          SB3    A0+         SAVE (A0)
 
*         CLEAR FLAG REGISTER BITS IF MMF PRESENT.
 
          TX5    MMK
          SB4    CIRI
 CIR1     SB6    CIR2
          TJP    (/ECS/SFR,MMF,/PRESET/CIR11)
 
 CIR2     SA0    /MMF/MBUF
          TX0    ETLT*100B+FRET,ECLT
          TX0    X0,TCNT
          SX2    A0+
          LX2    30
          BX0    X0+X2
          RE     18
          EQ     CIR9        IF PARITY ERROR
          SB6    CIR5
          TSX0   (402B,ESM,6B)
          LX0    21
          BX0    X0+X5
          ZR     X7,CIR4     IF INTERLOCK OBTAINED
          SA2    A0+B4
          LX2    6
          SX2    X2
          AX2    6
          TX2    X2,-MIN
          NZ     X2,CIR4     IF INTERLOCK HELD BY THIS MACHINE
          SB2    B2-B1       DECREMENT RETRY COUNT
          PL     B2,CIR1     IF NOT END OF RETRY COUNT
          JP     CIR11
 
 CIR3     SX2    X5+.TRTI    CLEAR TRTI INTERLOCK
          TSX0   (403B,ESM,7B)
          LX0    21
          BX0    X0+X2
 CIR4     RE     /ECS/FRWC
          EQ     CIR3
          SB4    18
 
 CIR5     SB4    B4-B1
          SA0    /MMF/MBUF
          SA3    A0+B4
          NG     B4,CIR9     IF END OF FLAG BITS
          AX3    12
          BX3    X5*X3
          NZ     X3,/ECS/CFR IF INTERLOCK HELD BY THIS MACHINE
          EQ     CIR5
 
*         CLEAR DEVICE INTERLOCKS FOR SHARED DEVICES IN ECS.
 
 CIR9     TX5    MIN         SET MACHINE INDEX
          MX7    -6
          SB7    B0-B1       SET START OF EST SEARCH
          SA0    /MMF/MBUF
          SB5    CIR10       *SSD* RETURN
          JP     /PROGRAM/SSD  SEARCH FOR SHARED DEVICE
 
 CIR10    NG     B7,CIR11    IF END OF SHARED DEVICES
          SX1    A0+
          SX0    X4+SDGL
          LX1    30
          BX0    X0+X1
          RE     1           READ DEVICE INTERLOCK
          JP     /PROGRAM/SSD
          SA1    A0
          BX2    -X7*X1
          AX2    B1
          BX2    X5-X2
          NZ     X2,/PROGRAM/SSD  IF NOT INTERLOCKED BY THIS MACHINE
          BX6    X7*X1
          SA6    A1
          WE     1           WRITE CLEARED INTERLOCK
          JP     /PROGRAM/SSD
 
 CIR11    SA2    ESTP        SET LAST MASS STORAGE ORDINAL + 1
          MX4    -12
          AX2    12
          BX2    -X4*X2
          SB7    X2+
 CIR12    ZR     B7,CIR13    IF END OF DEVICES
          SX2    B7-B1
          CX1    X2,EST      CONVERT EST ORDINAL TO OFFSET
          TA1    X1+EQDE,EST READ EST ENTRY
          SB7    B7-B1
          BX2    -X4*X1
          PL     X1,CIR12    IF NOT MASS STORAGE
          LX2    3
          MX6    12
          SA1    X2+DULL     CLEAR INTERLOCKS
          LX6    -12
          BX6    -X6*X1
          SA6    A1
          BX6    X6-X1
          SA1    X2+TDGL
          IX6    X1-X6
          SA6    A1
          EQ     CIR12
 
*         CLEAR INTERLOCKS AND EXIT.
 
 CIR13    NG     B2,CIRX     IF NO INTERLOCK TO CLEAR
          SB6    CIRX
          SB4    CIRI
          TJP    (/ECS/CFR,MMF,/PRESET/CIRX)  CLEAR INTERLOCK IF MMF
 
 CIRA     CON    0           RECOVERY MODE
 CLE      SPACE  4,10
**        CLE - CLEAR ECS.
*
*         FOR UEM AND ESM, WRITE MEMORY WITH ALL ZEROS.  FOR ECS AND
*         LCME, WRITE MEMORY WITH ALL ONES AND REWRITE WITH ALL ZEROS.
*
*         EXIT   (A0) RESTORED.
*                (X0) RESTORED.
*
*         USES   A - 0, 1, 2, 4, 6, 7.
*                B - 2, 4, 5, 6, 7.
*                X - ALL.
 
 
 CLE15    SA1    CCMB
          NZ     X1,CLE      IF NOT LARGE MEMORY 990
          SA0    CLEE
          LX2    X0          SAVE (X0)
          BX6    X6-X6
          SX0    A0          SET BUFFER ADDRESS
          SB6    377B
          LX0    30
 CLE16    SA6    A0+B6       CLEAR BUFFER
          SB6    B6-B1
          PL     B6,CLE16    IF MORE TO CLEAR
          WE     400B
+         SA0    B2          RESTORE REGISTERS
          BX0    X2
          SA7    CLEA        SET *CLE* RAN INDICATOR
 
 CLE      PS                 ENTRY/EXIT
          SA1    CLEA
          NZ     X1,CLE      IF *CLE* HAS BEEN RUN
          SA1    EMS         CHECK FOR FULL INITIALIZE PENDING
          MX7    -3
          SB2    A0
          ZR     X1,CLE15    IF NO XM EQUIPMENT
          SA1    X1+DILL
          AX1    18          EXTRACT XM TYPE
          BX7    -X7*X1
          SA0    CLEE
          BX6    X0          SAVE (X0)
          SX7    X7-5
          SA6    A0-B1
          NZ     X7,CLE1     IF NOT ESM
          SA2    ESM
          SA4    CLEB
          LX2    3+21        FUNCTION TO MATCH *POWER ON* STATUS
          BX0    X4+X2
          RE     /ECS/FRWC
 CLE1     SA1    A1+STLL-DILL
          SX7    X7+1
          AX7    60          = 0 FOR ESM/UEM, -0 FOR ECS/LCME
          LX1    59-LIAL
          PL     X1,CLE9     IF FULL INITIALIZE NOT SELECTED
          SA2    MECNF
          SX4    400B        EXTENDED MEMORY INCREMENT
          LX2    1
          SB4    X2          NUMBER OF 400 WORD BLOCKS TO TEST
          SA1    CLEC
          SB5    B0
          BX6    X1          SET MESSAGE FOR DISPLAY
          SA6    DSCP*CPAS+MS1W
          SA1    A1+1
          SA2    A1+1
          BX6    X1
          MX3    -3
          SA6    A6+B1
          BX6    X2
          SA1    A2+B1
          SA6    A6+B1
          BX6    X1
          SA6    A6+B1
 CLE2     SX0    A0          SET ADDRESSES FOR TRANSFER
          SB6    377B
          LX0    30
 CLE3     SA7    A0+B6       STORE TEST PATTERN IN BUFFER
          SB6    B6-B1
          PL     B6,CLE3     IF NOT END OF BUFFER
 CLE4     SX1    B5
          BX6    X2
          LX1    2           EXTENDED MEMORY ADDRESS / 100B
          SB7    B0
 CLE5     BX5    -X3*X1      EXTRACT NEXT DIGIT
          AX1    3
          SX5    X5+1R0-1R
          LX5    B7          CONVERT NUMBER FOR MESSAGE
          SB7    B7+6
          IX6    X6+X5
          NZ     X1,CLE5     IF MORE DIGITS
          SA6    DSCP*CPAS+MS1W+2
          WE     400B
-         EQ     *           (HANG ON HALF-EXIT)
+         SB5    B5+B1       INCREMENT BLOCK COUNT
          IX0    X0+X4
          NE     B5,B4,CLE4  IF NOT END OF EXTENDED MEMORY
 CLE6     SX1    B5-B1
          BX6    X2
          LX1    2           EXTENDED MEMORY ADDRESS / 100B
          SB7    B0
          BX7    -X7
          SA7    CLEE        INSURE COMPARE ERROR IF NO TRANSFER
          BX7    -X7
 CLE7     BX5    -X3*X1      EXTRACT NEXT DIGIT
          AX1    3
          SX5    X5+1R0-1R
          LX5    B7          CONVERT NUMBER FOR MESSAGE
          SB7    B7+6
          IX6    X6+X5
          NZ     X1,CLE7     IF MORE DIGITS
          SB6    377B
          SA6    DSCP*CPAS+MS1W+2
          IX0    X0-X4       DECREMENT EXTENDED MEMORY ADDRESS
          SB5    B5-B1
          RE     400B        FILL BUFFER
-         EQ     *           (HANG ON HALF-EXIT)
 CLE8     SA1    A0+B6
          SB6    B6-1
          BX1    X1-X7
+         NG     X1,*        IF COMPARE ERROR
-         NZ     X1,*        IF COMPARE ERROR
          PL     B6,CLE8     IF NOT END OF BUFFER
          NZ     B5,CLE6     IF NOT END OF EXTENDED MEMORY
          BX7    -X7
          SX6    B0
          PL     X7,CLE2     IF BOTH PATTERNS NOT USED
          SA6    DSCP*CPAS+MS1W
          EQ     CLE10       PROCESS *IBDT*
 
*         CHECK FOR CYBER 8XX MACHINE AND LEVEL 1 OR 2 DEADSTART.
 
 CLE9     SA1    MABL        CHECK MACHINE TYPE
          SA4    CIRA        GET RECOVERY LEVEL
          LX1    59-47
          NG     X1,CLE14    IF NOT CYBER 170-8X5
          SX4    X4-1
          ZR     X4,CLE10    IF LEVEL 1 DEADSTART
          SX4    X4-1
          NZ     X4,CLE14    IF NOT LEVEL 2 DEADSTART
 
*         BUILD *IBDT* AND ENTER IN LABEL TRACK.
 
 CLE10    SA1    EEM         CHECK FOR LINK DEVICE
          SA4    MMFL
          MX6    -9          MASK FOR EST ORDINAL
          AX4    36
          BX4    X4-X1
          BX4    -X6*X4
          SB4    1           (B4) = IBDT LIMIT
          SX6    1000B
          NZ     X4,CLE11    IF NOT LINK DEVICE
          SB4    MXMF
 CLE11    SA1    TNSC
          SB7    60
          SA2    TCNT        EXTENDED MEMORY SECTOR LIMIT
          SB5    X1
          SB7    B7-B5
          SA1    EMS         GET TRACK COUNT FROM MST
          LX6    B5
          SA1    X1
          ERRNZ  TDGL        CODE DEPENDS ON VALUE
          SX4    20B*101B
          AX1    48
          LX4    B5
          SX6    X6-1
          IX1    X1*X4
          IX4    X1+X6
          AX4    9           FWA OF BUFFERS IS END OF DEVICE
          LX4    B7
          SA1    DSDL
          MX0    -12
          SB5    12
          LX6    X0,B5       POSITION MASK
 CLE12    SA1    A1+B1
          MX0    -12
          BX7    X6*X1       CLEAR FWA FIELD
          BX0    -X0*X1      LENGTH
          ZR     X0,CLE13    IF NO I/O BUFFERS ON THIS MAINFRAME
          LX1    X4,B5       POSITION FWA
          BX7    X7+X1
 CLE13    SA7    A1
          IX4    X4+X0       NEW FWA
          SB6    A1-DSDL
          NE     B4,B6,CLE12 IF NOT END OF *IBDT*
          SA0    DSDL+1      WRITE TO LABEL TRACK
          SA1    ECLT        EXTENDED MEMORY LABEL TRACK ADDRESS
          SX0    X1+ETLT*100B+IBDT
          SX1    A0
          IX0    X0+X2
          LX1    30
          BX0    X0+X1
          WE     B4
 CLE14    SX6    B1          SET *CLE* RAN INDICATOR
          BX7    X7-X7
          SA6    CLEA
          SA2    CLED        RESTORE REGISTERS
          BX0    X2
          SA0    B2
          EQ     CLE         RETURN
 
 
 CLEA     CON    0
 CLEB     VFD    36/0,3/2,21/377B
 CLEC     DATA   C*TESTING EXTENDED MEMORY       00*
 CLED     CON    0
 CLEE     BSS    400B        EXTENDED MEMORY PRESET BUFFER
 DBL      SPACE  4
**        DBL - DETERMINE BLOCKS LOADED.
*         *DBL* SETS THE CONDITION WORDS IN *TDBL* WHICH TELL IF A
*         BLOCK HAS BEEN LOADED.  THESE CONDITION WORDS ARE USED FOR
*         SETTING THE CONDITIONAL VALUES IN THE *T* INSTRUCTIONS.
*
*         EXIT   TDBL IS SET ACCORDING TO THE BLOCKS LOADED.
 
 
 DBL      PS                 ENTRY/EXIT
          SA1    TDBL-1      CONDITION WORDS TO SET
          SB2    BLKT        LOADED BLOCK TABLE ADDRESS
 DBL1     SA1    A1+B1
          ZR     X1,DBL      IF END OF CONDITION WORDS
          SA2    B2-B1
 DBL2     SA2    A2+B1       READ LOADED BLOCKS
          BX6    X2-X1
          AX6    18
          BX7    X7-X7
          ZR     X6,DBL1     IF BLOCK PRESENT
          NZ     X2,DBL2     IF NOT END OF LOADED BLOCKS
          SA7    A1          CLEAR CONDITION WORD - BLOCK NOT PRESENT
          EQ     DBL1
 ILD      SPACE  4
**        ILD - INITIALIZE MULTI-MAINFRAME LINK DEVICE.
*
*         ENTRY  (EFRL) = 30/,6/  LS,12/,12/  LT.
*                       LS = 40, IF TO INITIALIZE LINK DEVICE.
*                       LS = 20, IF TO PRESET LINK DEVICE.
*                       LT = LABEL TRACK OF LINK DEVICE.
*
*         EXIT   ERROR CODES PASSED TO *RMS* IN (EFRL) -
*                1 = EXTENDED MEMORY LABEL TRACK NOT FOUND.
*                2 = RECOVERY DS. PREVENTED FOR THIS MACHINE ID.
*                3 = MACHINE ID IN USE.
*                4 = MMFL SLOT UNAVAILABLE.
*                5 = EXTENDED MEMORY READ/WRITE PARITY ERRORS.
*                6 = PRESET NOT ALLOWED.
*
*                (B6) = ERROR CODE.
 
 
 ILD33    SX6    /LSPMMF/TMMF  MERGE MMF TABLE ADDRESS IN *EFRL*
          LX6    36
          MX7    24
          BX7    -X7*X1
          BX6    X6+X7
          SA6    EFRL
 
 ILD      PS                 ENTRY/EXIT
          SA1    DSSL        SET RECOVERY LEVEL
          MX7    -2
          BX7    -X7*X1
          SA1    EFRL        GET PRESET, INITIALIZE FLAGS
          SB2    X7
          SB6    B0
          SA2    LSPMMF      CHECK FOR LSP LINK DEVICE
          NZ     X2,ILD33    IF NO CPU PATH
          MX4    -12
          BX7    -X4*X1      EXTENDED MEMORY LABEL TRACK
          LX1    59-29
          SX6    2020B
          SA3    TNSC
          SB5    X3
          LX6    B5,X6
          MX4    -11
          BX0    -X4*X7
          LX3    X1,B1       POSITION INITIALIZE BIT
          SA0    /PROGRAM/PBUF  SET ECS BUFFER ADDRESS
          IX0    X0*X6
          SX2    A0+
          LX2    30
          BX0    X2+X0
          NG     X3,ILD2     IF INITIALIZE OF LINK DEVICE
          SA3    ILDA
 
*         SEARCH FOR LABEL TRACK.
 
 ILD1     RE     1           READ LABEL SECTOR LINK WORD
          NO                 IGNORE EXTENDED MEMORY ERROR
 +        SA2    A0
          BX2    X2-X3
          ZR     X2,ILD2     IF LABEL TRACK FOUND
          SX2    X7+1-LTKL
          IX0    X0+X6       ADVANCE LABEL TRACK ADDRESS
          SX7    X7+B1       ADVANCE LABEL TRACK NUMBER
          NZ     X2,ILD1     IF NOT AT LIMIT OF LABEL TRACK SEARCH
          SB6    1
          EQ     ILD10       RETURN ERROR STATUS
 
 ILD2     MX6    -24
          BX6    -X6*X0      SET LABEL TRACK ADDRESS IN PRESET TABLE
          SA7    A1          SET LABEL TRACK NUMBER IN EFRL
          SA6    ECLT
 ILD3     SX2    .PRSI       SET PRESET INTERLOCK
          SA3    ESM
          SX0    400B
          NZ     X3,ILD3.1   IF ESM ENABLED
          SX0    4B
 ILD3.1   LX0    21
          BX0    X0+X2
          RE     /ECS/FRWC
          PL     X1,ILD3     IF NOT PRESET
          SA3    MMFL
          BX7    X7-X7
          SB4    B1+B1
          PL     X1,ILD11    IF NO PRESET OF LINK DEVICE
 
*         VALIDATE NO ACTIVITY IN ECS.
 
          SA4    TCNT
          IX4    X6+X4
          SX0    X4+ETLT*100B+SMET
          SX4    A0
          LX4    30
          BX0    X0+X4
          RE     MXMF
          EQ     ILD6        PRESET VALID IF EXTENDED MEMORY ERROR
          SA4    RTCL
          SB5    X4+1200     WAIT 1.2 SECONDS
 ILD4     CX4    X4          DELAY
          CX4    X4
          SA4    RTCL
          SB6    X4
          LT     B6,B5,ILD4    IF NOT END OF WAIT
          SA0    A0+MXMF
          SB6    5
          SX4    MXMF
          LX4    30
          IX0    X0+X4
          RE     MXMF
          EQ     ILD9        RETURN EXTENDED MEMORY ERROR STATUS
          SB6    6           *PRESET NOT ALLOWED.*
          SA1    A0
          SB4    A1
 ILD5     SA1    A1-B1       VALIDATE THAT CLOCKS ARE THE SAME
          SA4    A1+MXMF
          SB5    A4
          BX1    X1-X4
          SA0    A1          RESET A0
          NZ     X1,ILD9     IF MACHINE ACTIVE
          GT     B5,B4,ILD5  IF MORE MACHINES TO CHECK
          SB6    5           SET EXTENDED MEMORY ERROR STATUS
 ILD6     BX1    X0          CLEAR FLAG REGISTER EXCEPT *PRSI*
          BX0    -X2
          MX6    -18
          BX0    -X6*X0
          SA2    ESM
          SX6    403B
          NZ     X2,ILD6.1   IF ESM ENABLED
          SX6    7B
 ILD6.1   LX6    21
          BX0    X6+X0
          RE     /ECS/FRWC
          EQ     ILD9
          BX0    X1          RESTORE X0
          RJ     CLE         CLEAR ECS
 
*         CLEAR ENVIRONMENT SECTOR.
 
          SA3    A3          RESTORE (X3) = *MMFL*
          SB5    77B
          BX7    X7-X7
 ILD7     SA7    A0+B5       CLEAR SECTOR OF DATA
          SB5    B5-B1
          PL     B5,ILD7     IF MORE TO CLEAR
          SX1    B1          SET MACHINE INDEX 1
          SX0    X0-SMET
          SX4    A0
          LX4    30
          BX0    X0+X4
          WE     IBDT
          EQ     ILD9        PROCESS ERROR
          SX1    1           SET MACHINE INDEX
          SB6    5           SET EXTENDED MEMORY ERROR RETURN
*         SX0    X0+MFET
 
*         WRITE MMFL WORD IN MFET SLOT.
 
 ILD8     SB5    X1+11       SET MACHINE INDEX
          SX4    B1
          IX0    X0-X4
          LX4    X4,B5       MACHINE MASK
          IX0    X0+X1       ADDRESS IN MFET
          IX4    X4+X1
          BX6    X3+X4       SET MACHINE MASK AND INDEX IN MMFL
          SA0    A3
          SA6    A3
          SX6    X0+SMET-MFET
          MX2    -24
          BX0    -X2*X0
          SX2    A0
          LX2    30
          BX0    X2+X0
          WE     1
          EQ     ILD9        EXTENDED MEMORY ERROR
          IX0    X6-X1
          SA0    /MMF/ARMA   INITIALIZE MACHINE CLOCK TEMPORARIES
          SX0    X0+B1       ADDRESS OF MACHINE CLOCKS
          MX2    -24
          BX0    -X2*X0
          SX2    A0
          LX2    30
          BX0    X0+X2
          RE     MXMF
          EQ     ILD9        EXTENDED MEMORY ERROR
          SB6    B0          CLEAR ERROR STATUS
          SA6    ECCM        SET MACHINE CLOCK LOCATION
 
*         CLEAR FLAG REGISTER INTERLOCK AND RETURN IF NO ERROR.
 
 ILD9     SA2    ESM
          SX0    403B        CLEAR FLAG BIT FUNCTION
          NZ     X2,ILD9.1   IF ESM ENABLED
          SX0    7B
 ILD9.1   LX0    21
          SX2    .PRSI
          BX0    X0+X2
          RE     /ECS/FRWC
 ILD10    SX7    B6          SET ERROR CODE
          SA7    EFRL
          ZR     B6,ILD      IF NO ERROR
          SX6    B0          CLEAR FURTHER MMF PROCESSING
          SA6    MMF
          EQ     ILD         RETURN
 
*         ASSIGN/RECOVER MMFL SLOT IN ENVIRONMENT TABLE.
 
 ILD11    SA2    TCNT
          IX2    X6+X2
          SX0    X2+ETLT*100B+MFET
          SX1    A0
          LX1    30
          BX0    X1+X0
          SB6    5           EXTENDED MEMORY ERROR FLAG
          MX4    24
          MX1    MXMF-1
          RE     MXMF
          EQ     ILD9        IF ERROR
          SA2    A0          PRESET STATE TABLE
          BX6    X4*X2
          SA6    /MMF/TMMF+MFST
 ILD11.1  SA2    A2+B1
          BX6    X4*X2
          LX1    1
          SA6    A6+B1
          NG     X1,ILD11.1  IF NOT END OF MACHINES
          MX1    -12
          MX4    12
          SB3    MXMF-1
          LE     B2,B4,ILD12 IF NOT LEVEL 3 RECOVERY
 
*         VERIFY MMFL WITH MFET IF LEVEL 3 RECOVERY.
 
          BX1    -X1*X3      MACHINE INDEX
          MX4    24+12
          SA2    /PROGRAM/PBUF-1+X1  VERIFY ENTRY
          LX4    12
          BX2    X2-X3
          BX2    X4*X2
          ZR     X2,ILD8     IF ENTRY VERIFIES
          JP     ILD14
 
*         CHECK IF ENTRY EXISTS OR IF EMPTY SLOT. (LEVEL 0, 1, 2.)
 
 ILD12    SA2    A0+B3       READ ENTRY
          NZ     X2,ILD13    IF NOT EMPTY ENTRY
          SX1    B3+B1       SET EMPTY SLOT FOUND
 ILD13    BX6    X2-X3
          BX5    X4*X6
          ZR     X5,ILD15    IF MATCHING MACHINE ID
          SB3    B3-B1       CHECK NEXT ENTRY
          PL     B3,ILD12    IF NOT END OF ENTRIES
 
*         MACHINE ID NOT FOUND - ASSIGN EMPTY ENTRY.
 
          NZ     B2,ILD14    IF NOT LEVEL ZERO
          PL     X1,ILD8     IF EMPTY ENTRY FOUND
          SB6    4           *MID SPOT UNAVAILABLE.*
          JP     ILD9
 
 ILD14    SB6    2           *RECOVERY DEADSTART PREVENTED THIS MID.*
          JP     ILD9
 
*         MACHINE ID FOUND - VERIFY IF FOR THIS MACHINE.
 
 ILD15    SX1    B3+B1       SET MACHINE INDEX
          LX4    -12
          BX6    X4*X2
          NZ     B2,ILD16    IF RECOVERY DEADSTART
          ZR     X6,ILD8     IF LINK EQUIPMENT NOT PRESENT
          SB6    3           *MACHINE ID IN USE.*
          JP     ILD9
 
*         LINK DEVICE MUST BE PRESENT IN *MFET* FOR RECOVERY DEADSTART.
 
 ILD16    NZ     X6,ILD8     IF LINK EQUIPMENT PRESENT
          JP     ILD14       *RECOVERY DEADSTART PREVENTED THIS MID.*
 
 ILDA     VFD    24/37770077B,36/0LLABEL
          SPACE  4,10
*         INSURE PP EXCHANGE PACKAGES AND TABLE OF LOADED BLOCKS FIT.
 
 
 PRSO     EQU    *-PRSB      LENGTH OF OVERLAYABLE PRESET CODE
          ERRPL  21D*28D+/DSL/CPBL-PRSO  OVERFLOW
 COMMON   SPACE  4,10
*         COMMON DECKS.
 
 
          QUAL
*CALL     COMCCDD
*CALL     COMCEDT
          QUAL   *
          SPACE  4,10
          TITLE  NON-OVERLAYED PRESET.
          SPACE  4
**        PRSX - OVERLAY PRESET WITH PPU EXCHANGE PACKAGES.
 
 
 PRSX     RJ     SPS         SET PPU STATUS
          SX6    CL
          SA1    BLKT-1      *CPUMLD* LOADED BLOCKS TABLE
          SA6    A0+B1       SET MAIN BLOCK ADDRESS IN BLOCK TABLE
          SX7    A6
          SA7    CL+CBLP     SET *CPUMTR* LOADED BLOCK POINTER
 PRSX1    SA1    A1+B1       MOVE LOADED BLOCK TABLE
          BX6    X1
          SA6    A6+B1
          NZ     X1,PRSX1    IF NOT END OF TABLE
          TSX2   (/MONITOR/BXP,CPB,0)
          SA0    A6          UPDATE (A0)
          LX7    36
          SA6    A6-B1       REMOVE *PRESET* FROM BLOCK TABLE
          BX7    X7+X2
          SA7    CMBL        STORE BREAKPOINT POINTER WORD
          TNO    /MCE/PRS,MCE  IF MEMORY CLEARING ENABLED
          SX6    A0          SET LWA+1 OF CPUMTR
          SA6    B0
          EQ     CPSL        BRANCH TO STOP
 SPS      SPACE  4
**        SPS - SET PPU STATUS.
*
*         ENTRY  (A0) = LAST ADDRESS OF CPUMTR.
*
*         EXIT   (A0) = LAST ADDRESS OF CPUMTR.
 
 
 SPS      PS                 ENTRY/EXIT
 
*         ASSIGN SYSTEM CONTROL POINT PP-S.
 
          TX1    0,SC        SET SYSTEM CP FOR PP ASSIGNMENT
          LX1    36
          SX6    3RMTR
          SX7    3RDSD
          LX6    42
          LX7    42
          BX6    X6+X1
          BX7    X7+X1
          TA6    0,FP        ASSIGN *MTR* TO PP 0
          TA7    1*PPCE,FP   ASSIGN *DSD* TO PP 1
          SX6    3RSTL
          SX7    3RDIO
          LX6    42
          LX7    42
          BX6    X6+X1
          BX7    X7+X1
          TA6    2*PPCE,FP   ASSIGN *STL* TO PP 2
          TA7    10B*PPCE,FP ASSIGN *DIO* TO PP 10
          TA1    STSW,SCA
          SX2    4
          LX2    48
          IX6    X1+X2       INCREMENT SYSTEM CP PP COUNT
          SA6    A1+
          SA1    PPUL        READ PPU STATUS
          SB2    20-2        PRESET 20 PPU
          LX1    -24
          SB6    PPCE
          MX3    -12
          BX4    -X3*X1
          SX3    X4-11
          SB3    B1
          MX6    1
          BX7    X7-X7       CLEAR ASSEMBLY
          LX6    -12-1       POSITION TO PP 1
          TA1    1*PPCE,FP   SET PPU 1
          PL     X3,SPS1     IF MORE THAN 10 PPU
          SB2    10D-2       SET 10 PPU
 
*         BUILD THE PP ALLOCATION BIT MAP.
 
 SPS1     SA1    A1+B6       READ NEXT INPUT REGISTER
          AX6    B3,X6       POSITION ALLOCATION BIT
          SB4    B2-10D
          NZ     B4,SPS1.1   IF PP NOT PP20
          SB3    -B1         SWITCH SHIFT DIRECTION
          AX6    10D-1       REPOSITION PP AVAILABLE FLAG
 SPS1.1   SB2    B2-B1
          NZ     X1,SPS2     IF NOT AVAILABLE
          BX7    X7+X6       MERGE ALLOCATION BIT
 SPS2     NZ     B2,SPS1     IF NOT END OF PPU
          SA5    /MONITOR/PXP  SET EXCHANGE PACKAGE FIRST WORD
          SB7    A1+B6       SET LAST PPU ADDRESS
 
*         CALCULATE LENGTH OF ALL EXCHANGE PACKAGES FOR CPP-S
*         AND CPP AVAILABLE COUNT.
 
          SA2    CPPL
          LX2    0-12
          MX0    -6
          BX2    -X0*X2
          BX0    X0-X0
          ZR     X2,SPS2.3   IF NO CPP-S PRESENT
          SB2    X2
 SPS2.1   SA1    A1+B6       READ NEXT INPUT REGISTER
          NZ     X1,SPS2.2   IF CPP NOT AVAILABLE
          SX0    X0+B1       INCREMENT CPP AVAILABLE COUNT
 SPS2.2   SB2    B2-B1
          NZ     B2,SPS2.1   IF MORE CPP-S TO CHECK
          LX0    12-0
          BX7    X7+X0
          LX2    PPCES
          SB7    B7+X2       ADD IN CPP-S EXCHANGE PACKAGES
 
*         GENERATE PPU EXCHANGE PACKAGES.
 
 SPS2.3   SA7    PPAL        SAVE ALLOCATION STATUS AND CPP COUNT
          SX6    A0
          SA6    PXPP        SET ADDRESS OF FIRST PP EXCHANGE PACKAGE
          BX6    X5
          TB4    2*PPCE,FP   PP 2 COMMUNICATION AREA ADDRESS
          SA6    A6+B1
          SA1    A0+20B      PRESET (A6)
          BX6    X1
          SA6    A1
          SX4    21B         SET EXCHANGE PACKAGE ADDRESS INCREMENT
          SX3    B6          SET A5 INCREMENT
          LX3    18
 SPS3     SB4    B4+B6       INCREMENT PP ADDRESS
          MX7    -21B
          GE     B4,B7,SPS5  IF END OF PPU-S
 SPS4     BX6    X5          COPY PREVIOUS EXCHANGE PACKAGE
          AX7    1
          SA6    A6+B1
          SA5    A5+B1
          NZ     X7,SPS4     IF NOT END OF EXCHANGE PACKAGE
          SA1    A6-20B+5    INCREMENT (A5)
          IX7    X1+X3
          SA7    A1
          SA1    A1-5+2      INCREMENT (B2)
          IX7    X1+X4
          SA7    A1
          SA2    B4
          LX2    12
          SX2    X2-2R**
          ZR     X2,SPS3     IF NO PP PRESENT
          SA0    A6          SET LWA OF EXCHANGE PACKAGES IN USE
          EQ     SPS3
 
*         INITIALIZE EXTENDED PP CONTROL BLOCKS.
 
 SPS5     TX6    0,SCA
          BX1    X6
          LX1    48-7
          BX7    X1+X6
          LX6    24
          BX6    X6+X7       *ACPP* FOR SYSTEM CP ASSIGNMENT
          MX7    12
          TB4    0,FP        START OF PP COMMUNICATION AREA
          TB3    0,FPX       START OF EXTENDED PP CONTROL BLOCKS
SPS6      SA1    B4          READ NEXT INPUT REGISTER
          SA7    B3+DRQP     INITIALIZE PENDING DISK REQUEST STATUS
          LX1    12
          ZR     X1,SPS7     IF NOT ASSIGNED PP
          SX1    X1-2R**
          ZR     X1,SPS7     IF NOT ASSIGNED PP
          SA6    B3+ACPP     SET SYSTEM CP ASSIGNMENT
SPS7      SB4    B4+PPCE
          SB3    B3+PPXE
          LE     B4,B7,SPS6  IF NOT PAST PSEUDO-PP
          EQ     SPS         RETURN
 
 
 PRBL     EQU    *-PRSB      LENGTH OF *PRESET* BLOCK
 REL      SPACE  4
**        TERMINATE THE *TREL* BLOCK WHICH CONTAINS THE RELOCATION
*         INFORMATION FOR PRESET.
 
 
          USE    /TREL/
          CON    0,0
 
 TRELL    EQU    *-REL       LENGTH OF *TREL* BLOCK
          USE    *
 TJMP     SPACE  4,10
**        TERMINATE TJMP BLOCK.
 
 
          USE    /TJMP/
          CON    0,0
 
 TJMPL    EQU    *-TJMP      LENGTH OF *TJMP* BLOCK
          USE    *
          SPACE  4,10
**        BLKT - LOADED BLOCK NAME TABLE DECLARATION.
 
 
          USE    /TBLK/
 BLKT     BSS    0           LOADED BLOCK NAME TABLE
 
 TBLKL    EQU    /DSL/CPBL   MAXIMUM LENGTH OF *TBLK* BLOCK
          USE    *
          SPACE  4
 PRSL     EQU    PRBL+TRELL+TJMPL+TBLKL
 
          ERRNG  /DSL/PRSL*100B-PRSL  IF *PRESET* OVERFLOW
          QUAL
 CPUMTR   EQU    /PRESET/PRS
          SPACE  4
          TTL    CPUMTR - CPU MONITOR.
 SAC      HERE
 
          END    CPUMTR