         PCC      0
         TITLE    'SCHEDULER REFS AND DEFS'
         SYSTEM   UTS
         DEF      SCHED
PMONOFF EQU 1
PFRQ     SET      1
*P*************************************************************
*M*               SCHED - EXECUTION AND SWAP SCHEDULER        *
*P*************************************************************
         SPACE    2
SCHED    EQU      %
**********************************************************
*                                                        *
*             C P - V    S C H E D U L E R               *
**********************************************************
*                                                        *
*        SCHEDULES USERS FOR SWAPPING AND FOR            *
*        EXECUTION.  ALSO HANDLES TRAP AND INTER-        *
*        RUPT EXITS.                                     *
*                                                        *
**********************************************************
         SPACE    2
*        ORIGINAL IMPLEMENTATION FOR UTS BY:
*                                             G. A. PERRY
*                                             H. L. SCANTLIN
*
*        SPEED-UP ENHANCEMENTS BY: T. W. MARTIN
*
*        MULTI-PRIORITY SCHEDULING FOR REAL TIME BY:
*                                             R. I. HUSTVEDT
*
         PAGE
         DEF      T:CHS
         DEF      T:PGCHK,TSS2,PGCHKM
         DEF      T:TOTSZ
T:TOTSZ  EQU      T:TOTESZ
         DEF      GIVEUP
         DEF      GETJIT
         DEF      STIOCC            IO COMPLETE TRANSITION
         DEF      SEXU              EXECUTABLE STATE NUMBER
         DEF      T:RE              REPORT EVENT FOR CURRENT USER
         DEF      T:RUE             REPORT EVENT FOR SPECIFIED USER
         DEF      T:RCE             REPORT EVENT FOR COC LINE
         DEF      ALTERR            STACK PROBLEM FOR ALTERNATE ENTRY
         REF      M7,M8,M17,Y8
         REF      YFF,Y4,Y008,Y004,DOUBLEZERO
         REF      M24
         REF      M21
         REF      X8000
         REF      Y7F
         PAGE
*************************************
*        ALL REFS                   *
*************************************
*
* SYSTEM LIMITS FOR SCHEDULER
         REF SL:QMIN                MIN. QUANTUM SIZE
         REF      SL:SQPB           PRIO BOOST IF INTERRUPT AFTER SQNT
         REF      SL:SQNT           THRESHOLD AT WHICH TO EXPEDITE USER
*
* USER TABEL REFS
*
         REF      UX:JIT
         REF      UH:FLG
         REF      UH:AJIT
         REF      UB:PCT
         REF      UB:ACP
         REF      UB:APR
         REF      UB:APO
         REF      UB:ASP
         REF      UB:DB
         REF      UB:OV
         REF      UB:US
         REF      UB:FL
         REF      UB:BL
         REF      UB:NECB
         REF      UH:DL             DO LIST HEAD
         REF      UB:PRIO           USER EXECUTION PRIORITY
         REF      UB:PRIOB          BASE EXECUTION PRIORITY
         REF      U:MISC            MISC CELL FOR RESOURCE SUB-QUEUES
         SREF     ECBFBLK           ENTRY POINT TO FREE DO LIST BLOCKS
*
* JIT REFERENCES FOR SCHEDULER
*
         REF      M:OC
         REF      J:RNST
         REF      J:ABC
         REF      ERO
         REF      J:INTENT
         REF      J:OVHTIM
         REF      J:UTIMER
         REF      J:TIMENT
         REF      J:TCB
         REF      J:JIT
         REF      J:DELTAT
         REF      J:IDELTAT
         REF      J:CTIME
         REF      JBPPC PHY PG HEAD, TAIL & COUNT
         REF      J:TELFLGS
         REF,1    JB:PNR
         REF      JTSTACKSZ
         REF      BUFMASK
         REF,1    JB:FRS
*
* MEM MGMT REFS
*
         REF      T:PAC
         REF      M:FPPH,M:FPPT,M:FPPC
         REF      MX:PPUT           MONITOR PHYSICAL PAGE TABLES
        REF      NPMC
         REF      SL:RSVP           COUNT OF PAGES RESERVED FOR STEALER
         REF      S:STL#            NUMBER OF CUR STOLEN PAGES
         REF      S:RTCORE          TOTAL OF REAL TIME HOLD PAGES
* LINE TABLE REFS
*
         SREF     LB:UN             LINE TO USER NO TABLE
         SREF     LNOL              NO OF LINES
         REF      COCOFF
*
* PERFORMANCE MEASUREMENT REFS
*
PERFORM  EQU      PMONOFF
         REF      DID%IO
         DO PERFORM
         REF      C:PROCREQ
         REF      C:NOPROC
         REF      ACTIVATE
         FIN
         REF      C:IDLES
         REF      C:IDLE
         REF      C:NSP
         REF      C:TINC            CLOCK 3 COUNTER CELL
*
* PRDC. TABLE REFERENCES
*
         REF      PPROCS            NO OF PROCS
         REF      PX:HPP            HEAD OF PHYSICAL PAGES
         REF      PX:TPP            TAIL        "      "
         REF      PB:PSZ            PROCEDURE SIZE
         REF      PB:UC             USER COUNT
         REF      PBT:LOCK          PROC LOCK
         DO1      PFRQ
         REF      PH:FRQ            CALL FREQUENCY
         REF      PB:LCT            COUNT OF ASSOC LOCKED USERS
*
*
         REF      T:SEXIT
*
* STEP REF
*
         REF      SYSACT
         REF      T:TELDELCCI
         REF      S:ACORE           AVAIL CORE
         REF      S:STLC            STEALABLE PAGES
         REF      T:ABORTM
*
* SCH DATA REFS
*
         REF      S:OUAIS
         REF      S:OUIS
         REF      S:HIR
         REF      S:EVF
         REF      S:SEVF            SWAP SET CHANGE COUNTER
         REF      S:FSEVF           SEVF AT SWAP SCHED FAIL
         REF      S:ISUNF           ISUN AT SWAP SCHED FAIL
         REF      ALLOOUT           ALLOCAT OUTSWAP REQ FLAG
         REF      S:CUIS
         REF      S:CUN
         REF      S:SIP
         REF      SPPBASE
         REF      SPDBASE
         REF      PULLE1
         REF      S:OPC             OVERLAY PROTECTION COUNTER
         REF      MAXOVLY           HIGHEST OVERLAY NUMBER
         REF      S:CUP             CURRENT USER PRIORITY
         REF      SH:PINC           PRIORITY INCREMENT TABLE
         REF      S:RTIR            REAL TIME IN FLAG
         REF      S:PRIODEC         PRIORITY DECREMENT
         REF      SB:RQ             HEAD OF RESOURCE SUBQ
         REF      SB:RTUS           REAL TIME USER NUMBER
         REF      SL:OPRIO          DEFAULT ONLINE PRIORITY
* SWAPPER REFS
*
         REF      M:FREE#GRAN
         REF      MB:SPACEJIT
         REF      M:JITPAGE
         REF      UB:SWAPI
         REF      T:SGAJIT
         REF      LSWAP
         REF      UH:FLG2
         REF      T:DELUSZAP
         REF      T:SCRATCH%USER
         REF      SMAXOUT
         REF      S:ISUN
         REF      SB:NP
         REF      SB:PNL
         REF      S:PCT
         REF      S:FPPH,S:FPPT,S:FPPC
         REF      SB:OSN
         REF      SB:OSUL
         REF      SB:FPN
         REF      SB:FPL
         REF      S:OSS
         REF      S:ACCW,S:MAPCW,S:SJACCW
         REF      SWAPIN,SWAPOUT
         REF      S:FPL
         REF      S:PRPC
*
* SCH Q REFS
*
         REF      SB:HQ
         REF      SB:TQ
*
*        ACCOUNTING REFS
*
         REF      T:ACCTEX
*
* MISC REFS
*
         REF      SL:OIMF,SL:BIMF
         REF      UB:MF
         REF      J:ACCN
         REF      SL:SQUAN
         REF      OPNCLSUS
         REF      RCVPSD
         REF      SACT
         REF      S:PCORE
         REF      SNDDX
         REF      SSIG
         REF      MAXG
         REF      SB:GJOBUN
         REF      S:CLOCK4          CLOCK4 COUNTER DIRECTOR
*
*        MP INTERFACE REFS
*
         REF      T:SES             SCHEDULE EXECUTION FOR SLAVES
         REF      T:MASTER          CHECK FOR MASTER AND CLR MASTERO
         REF      T:SMPFLG          SET MASTER ONLY FLAG
         REF      XFFF
M12      EQU      XFFF
XFDFF    EQU      NB31TO0+14
         REF      XN2
OPNCLSUSR EQU     8                 USER IS OPNCLS USER
SPECFILE EQU      4
OPNBOOST EQU      X'04'             PRIORITY BOOST FOR OPNCLSUS
SQUAN    EQU      8                 UH:FLG2 NOT HAD SWAP QUAN BIT
SWAPD    EQU      16                UH:FLG2 JUST SWAPPED IN
RTHOLD   EQU      X'800'            UH:FLG2 REAL TIME OLD
CALINT   EQU      X'200'            UH:FLG2 INTERRUPTED IN A CAL
RMAHOLD  EQU      X'2000'           UH:FLG2 RMA HOLD IN CORE
HANGUP   EQU      X'20'             UH:FLG2 COC LINE HANG UP
BYPASS   EQU      X'8000'           UH:FLG SWAP BYPASS FOR PAGE STEALING
INHIBIT  EQU      2                 UH:FLG INTENTRY INHIBIT
         TITLE    'S T A T E   D E F I N I T I O N S'
*
*STATE  NOS
STATE    CNAME
         PROC
ST%      SET      ST%+1
LF       EQU      ST%
         DISP     ST%
         DEF      LF
         PEND
********************************************************************
*
*        DEFINE STATE VALUES
*
*        ORDERING OF EXECUTABLE STATES IS CRITICAL
*
*        STATES STI,STIO STOB,STOBO SQR,SQRO MUST BE PAIRED
*        THIS IS USED BY THE KICKOUT ROUTINE TO COMPUTE THE
*        OUT OF CORE STATE.
*
********************************************************************
ST%      SET      0
*
SRT      STATE                      REAL TIME EXECUTE
SC0      STATE                      BGRD X'BF'< PRIO < X'F6'
SC1      STATE                      PRIO = X'F6'
SC2      STATE                      PRIO = X'F7'
SC3      STATE                      PRIO = X'F8'
SC4      STATE                      PRIO = X'F9'
SC5      STATE                      PRIO = X'FA'
SC6      STATE                      PRIO = X'FB'
SC7      STATE                      PRIO = X'FC'
SC8      STATE                      PRIO = X'FD'
SC9      STATE                      PRIO = X'FE'
SC10     STATE                      PRIO = X'FF'
SEXU     EQU      ST%               LAST EXECUTABLE STATE
SCU      STATE                      CURRENT USER
********************************************************************
*        THESE STATES MUST BE PAIRED (STOB,STOBO)
*
STOB     STATE                      TERMINAL OUTPUT BLOCKED
STOBO    STATE                      TERMINAL OUTPUT BLOCKED - OUT
******************************************************************
*        SIOW AND SIOMF MUST BE ADJACENT STATES
*        AND SIOW MUST BE EVENLY DIVISIBLE BY 4
*
SIOW     STATE                      I/O WAIT
SIOMF    STATE                      MASTER FUNCTION COUNT TOO HIGH
******************************************************************
SW       STATE                      WAIT (ASLEEP)
SQA      STATE                      QUEUED FOR ACCESS
******************************************************************
*        THESE STATES MUST BE PAIRED (SQR,SQRO)
*
SQR      STATE                      QUEUED FOR RESOURCE
SQRO     STATE                      QUEUED FOR RESOURCE OUT OF CORE
******************************************************************
*        THESE STATES MUST BE PAIRED (STI,STIO)
*
STI      STATE                      TERMINAL INPUTTING
STIO     STATE                      TERMINAL INPUTTING - OUT
******************************************************************
SQFI     STATE                      QUEUED FOR INTERRUPT
SNULL    EQU      30                NULL STATE FOR EMPTY USER SLOTS
SNSTS    EQU      31                NUMBER OF STATES
         DEF      SNSTS
         DEF      SNULL
******************************************************************
*
*        LIST OF EXECUTABLE STATES FOR STATE EVENT
*        TRANSITION TABLE FORMATION.
*
EXECUTE  EQU      SRT,SC0,SC1,SC2,SC3,SC4,SC5,SC6,SC7,SC8,SC9,SC10
******************************************************************
*
MASK     CNAME
         PROC
TEMP     SET      0
I        DO       NUM(AF)
TEMP     SET      TEMP|1**AF(I)
         FIN
LF       DATA     TEMP
         PEND
*
*
*
         DEF      EXU:MASK,WAIT:MASK,IOWAIT:MASK,BLCKD:MASK
EXU:MASK     MASK SRT,SC0,SC1,SC2,SC3,SC4,SC5,SC6,SC7,SC8,SC9,SC10,SCU
WAIT:MASK    MASK SW,SQFI
IOWAIT:MASK  MASK STOB,STOBO,SIOW,STI,STIO
BLCKD:MASK   MASK SIOMF,SQA,SQR,SQRO
*
         PAGE
*
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         PAGE
*
* EVENT  NOS
*
         BOUND    8
C3MP     GEN,10,22  1,CK3UM1
         DATA     X'17000000'
19SPD    DATA     TSTACK+1+19       TSTACK SPD WITH 19 WORDS IN IT.
         GEN,16,16 JTSTACKSZ-19,19   (MUST BE ON DW BOUNDARY).
SMPSD    DATA     X'00C00000'       PSD WHICH SAYS SLAVE, MAPPED,
         DATA     0                   WK=0.
TEL      RES      0
         TITLE    'EVENT DEFINING PROCEDURES'
         PAGE
*
* TRANSITION TABLES
*
SB:SET   CSECT    0                 BYTE TABLE GIVING OPERATION TO BE
         DEF      SB:SET:,S:SET:,SB:SWP:
SB:SET:  EQU      SB:SET
S:SET:   EQU      S:SET
SB:SWP:  EQU      SB:SWP
*                                   DONE GIVEN EVENT AND STATE
S:SET    CSECT    0                 WORD TABLE CORRESPONDING TO SB:SET
*
*        THESE PROCS DEEFINE EVENT STATE RELATIONSHIPS
*
*        THE EVENT NUMBER IS THE STARTING POSITION IN
*        S:SET AT WHICH TO BEGIN THE SEARCH FOR A STATE MATCH
*        THE RESULT OBTAINED FROM SB:SET WILL BE EITHER A STATE
*        NUMBER IF LESS THAN X'20' OR A DISPLACEMENT FROM
*        S:TRNSVEC.  AN ERROR WILL BE FLAGGED IF THE OFFSET FROM
*        S:TRNSVEC IS TOO LARGE(>X'E0').
*
ESTS     CNAME    0                 NO CONTINUATION
ESTS1    CNAME    1                 CONTINUATION
         PROC
U        SET      %                 REMEMBER CURRENT CS POSITION
         USECT    S:SET
         DO       NAME
P        SET      X'80000000'       SET CONTINUATION BIT(BIT 0)
         ELSE
P        SET      0
         FIN
LF       EQU      %-S:SET
         DEF      LF
         DO       SCOR(AF(2),ALL)
P        SET      P|X'7FFFFFFF'
         ELSE
I        DO       NUM(AF)-1
P%       SET      AF(I+1)
I%       DO       NUM(P%)
P        SET      P|(1**P%(I%))
         FIN
         FIN
         FIN
         DATA     P                 GENERATE S:SET WORD
         USECT    SB:SET
         DO       TCOR(AF(1),S:RAD,S:SUM,S:EXT,S:FR,S:LFR)>0
P        SET      AF(1)-S:TRNSVEC+X'20'
         ERROR,7,P>X'FF' 'SPECIAL TRANSITION ROUTINE TOO FAR FROM',;
                  ' S:TRNSVEC'
         DATA,1   P
         ELSE
         DATA,1   AF(1)
         FIN
         USECT    U
         PEND
         PAGE
*
*        THIS PROC DEFINES THE EVENTS FOR BLOCKING ON
*        UNAVAILABLE RESOURCES AND RESTARTING WHEN RELEASED
*        EACH CALL DEFINES TWO EVENTS; THE BLOCK EVENT(LF(1))
*        AND THE UNBLOCK EVENT(LF(2)).
*        FLAGS MAY BE SPECIFIED FOR EACH RESOURCE DEFINING
*        WHETHER OR NOT TO CHANGE STATE UPON THE RECEIPT OF
*        AN ERR,ABRT,EC OR BRK.  ANOTHER FLAG PERMITS THE ENTIRE
*        SUB-QUEUE TO BE FLUSHED WHEN AN UNBLOCK EVENT IS REPORTED.
*        A FLAG WILL ALTER THE MEANING OF THE UNBLOCK EVENT SUCH
*        THAT THE USER TO BE UNBLOCKED IS THAT FOR WHOM THE
*        EVENT IS REPORTED.  NORMALLY THE USER NUMBER ASSOCIATED
*        WITH THE UNBLOCK REPORT IS IGNORED AND THE CORRECT USER
*        NUMBERS ARE OBTAINED FROM THE RESOURCE SUB-QUEUE.
*
*
*        OPTIONAL EXITS ARE PROVIDED AT BOTH BLOCK AND UBLOCK
*        EVENTS TO PERFORM SPECIAL CHECKING ETC.
*
*E:BLK,E:REL RESOURCE       RTBLK,RTREL,FLAGS
*
RESOURCE CNAME    0
         PROC
U%       SET      %
         USECT    SB:RBLK
CF(2)    EQU      BA(%)-BA(SB:RBLK)
         DEF      CF(2)
         DATA,1   AF(1)-T:BLKV
         USECT    SH:RFLG
         DATA,2   (AF(2)-T:RELV)+AF(3)
LF(1)    ESTS     T:RES,SCU
LF(2)    ESTS     T:RES,ALL
         USECT    U%
         PEND
*
*        BLOCK CALLS SHOULD ONLY BE MADE VIA T:REG
*        RELEASE EVENTS MAY BE REPORTED VIA T:RUE OR T:RE
*
SB:RBLK  CSECT    0
SH:RFLG  CSECT    0
*
*
         OPEN     EC,BRK,ABRT,ERR,FLUSH
ABRT     EQU      X'8000'           ABORT FLAG
ERR      EQU      X'4000'           ERR FLAG
EC       EQU      X'2000'           CONTROL-Y FLAG
BRK      EQU      X'1000'           BREAK FLAG
SPECIFIC EQU      X'100'            SPECIFIC USER ONLY
FLUSH    EQU      X'200'            FLUSH ALL
NULL     EQU      X'400'            DO RELEASE ACTION IF NULL QUEUE
*
ESTS2    CNAME
         PROC
         BOUND    4
LF       DATA,1   0
K        SET      0
J        DO       NUM(AF)-1
         DATA,1   AF(J+1)
K        SET      K+(1**(AF(J+1)))
         FIN
         DATA,1   0
AF(1)    SET      0
L        DO       31
         DO       (K&(1**L))=((K&(1**(L-1)))**1)
         ELSE
AF(1)    SET      AF(1)+(1**(32-L))
         FIN
         FIN
         BOUND    4
         PEND
         TITLE    'STATE - EVENT TRANSITION TABLES'
*
* STATE  EVENT TRANSITIONN TABLES.   FISRT ARGUMENT  OF PROC  IS
*        ACTION TO TAKE. OTHER ARGS ARE THE STATES,
*        GIVEN THE EVENT, THAT SHOULD CAUSE THE ACTION
*******************************************************************
*
*        THESE EVENTS(E:IIP,E:QMF) MUST APPEAR FIRST AND IN THIS  ORDER
*
*
E:IIP    ESTS     STIIP,SCU
E:QMF,E:IP ESTS   STIOMF,SCU
*
*
*
*******************************************************************
*
E:CRD    ESTS     STCRD,SCU         TERMINAL READ EVENT
*
*        REPORTED BY: COC
*
*******************************************************************
*
*
E:CIC    ESTS1    STIRC,STI,STIO    TERMINAL INPUT COMPLETE
         ESTS     STIRCU,SCU        TERMINAL INPUT COMPLETE FOR CU
*
*        REPORTED BY: COC
*
*        SPECIAL CASE REQUIRED TO HANDLE COMPLETION BEFORE E:CRD
*        IS REPORTED.
*
*******************************************************************
*
*
E:CBL    ESTS     STOB,SCU          TERMINAL OUTPUT BLOCK
*
*        REPORTED BY: COC
*
*******************************************************************
*
*
E:CUB    ESTS1    STOC,STOB,STOBO   TERMINAL OUTPUT CONTINUE
         ESTS     STNOP,EXECUTE,SCU,STI,SW,SIOW,SIOMF,SQA,SQR,;
                  STIO,SQFI
*
*        REPORTED BY: COC
*
*******************************************************************
         PAGE
*******************************************************************
*
*        WARNING: THE EVENT E:CBK MUST BE AN EVEN NUMBER AND
*                 MUST BE FOLLOWED BY THE EVENTS E:CEC,E:ERR
*                 AND E:OFF IN THAT ORDER.
*
*                 THE SEQUENCE OF EVENT NUMBERS IN THIS SERIES
*                 WILL BE USED TO SELECT PROPER FLAG BITS FOR UH:DL
*
*
*******************************************************************
*
*
E:CBK    ESTS1    STBEEA,SCU,SIOW,SIOMF,SQA,SQR,SQRO,SNULL
         ESTS     STBEEAC,EXECUTE,SW,STI,STIO,STOB,STOBO,SQFI
         LIST     0
         ERROR,7,1&E:CBK         'E:CBK MUST BE AN EVEN NUMBERED EVENT'
         LIST     1
*
*        REPORTED BY: COC
*
*******************************************************************
*
*
E:CEC    ESTS1    STBEEA,SCU,SIOW,SIOMF,SQA,SQR,SQRO,SNULL
         ESTS     STBEEAC,EXECUTE,SW,STI,STIO,STOBO,SQFI,STOB
*
*        REPORTED BY: COC
*
*******************************************************************
*
*
E:ERR    ESTS1    STBEEAC,EXECUTE,SW,SQFI
         ESTS     STBEEA,SCU,SIOW,STOB,STOBO,SIOMF,;
                  SQA,SQR,SQRO,SNULL,STIO,STI
*
*        REPORTED BY: KEYIN
*
*******************************************************************
*
*
E:OFF,E:ABRT ESTS1 STBEEAC,EXECUTE,SW,STI,STIO,SQFI,SQA
         ESTS     STBEEA,SCU,SIOMF,SIOW,STOB,STOBO,SQR,SQRO,;
                  SNULL
*
*        REPORTED BY: COC,KEYIN
         LIST     0
U%       SET      (2=(E:CEC-E:CBK))&(2=(E:ERR-E:CEC))&(2=(E:OFF-E:ERR))
         ERROR,7,0=U% 'E:CBK,E:CEC,E:ERR AND E:OFF MUST APPEAR IN ORDER'
         LIST     1
*
*******************************************************************
*
*
E:WU     ESTS1    STSC,SW,SQFI      WAKE UP
*
*        REPORTED BY: CLOCK4
*
         ESTS     STNOP,ALL         IGNORE
*******************************************************************
*
*
E:SL     ESTS     SW,SCU            SLEEP
*
*        REPORTED BY: UCAL,RBBAT,TYPR
*
*******************************************************************
*
*
E:QA     ESTS     STQA,SCU          Q FOR ACCESS
*
*        REPORTED BY: COOP
*
*******************************************************************
*
*
E:ART    ESTS1    STNOP,SCU,SIOW,SIOMF,SQR,SQRO,SQA,STI,STOB,STIO,;
                  STOBO,SNULL
         ESTS     STSCOM,SQFI,SW,EXECUTE
*
*        REPORTED BY: RTROOT
*
*******************************************************************
*
*
E:UQA    ESTS1    STUQA,SQA,SIOW,SCU,EXECUTE
         ESTS     STNOP,ALL
*
*        REPORTED BY: RBBAT
*
*******************************************************************
*
*
E:KO     ESTS1    STKO,SW,SQFI,EXECUTE,SQA,SIOMF,SIOW
         ESTS     STKOT,STOB,STI,SQR
*
*        REPORTED BY: SWAPPER
*
*******************************************************************
*
*
E:AP,E:NC ESTS    STASP,SCU         ASSOCIATE SHARED PROCESSOR
*
*        REPORTED BY: E:NC - MM
*                     E:AP - STEP,SCHED,UCAL
*
*******************************************************************
*
*
E:QE     ESTS     STSCOM,SCU
*
*        REPORTED BY: LBLT(MOVE CAL)
*
*******************************************************************
E:IC     ESTS     STIOC,ALL         I/O COMPLETE
E:QFI    ESTS     SQFI,SCU          QUEUE FOR INTERRUPT
E:REL    EQU      E:NSYMF           BASE EVENT FOR RESOURCES
E:NSYMF,E:SYMF RESOURCE,R:SYMF T:BLKV,T:RELV,FLUSH
E:NSYMD,E:SYMD RESOURCE,R:SYMD T:BLKV,T:RELV,FLUSH
E:OCR,E:NOCR   RESOURCE,R:OCR T:BLKV,OPNUNBLOCK
E:CFB,E:CBA    RESOURCE,R:CBA T:BLKV,T:RELV,FLUSH
E:ND,E:DPA     RESOURCE T:BLKV,T:RELV,FLUSH
E:QFAC,E:UQFAC RESOURCE T:BLKV,UQFAC,FLUSH+NULL
E:NQW,E:NQR RESOURCE,R:NQW  T:BLKV,T:RELV,ERR+ABRT+EC+BRK+SPECIFIC
         TITLE    'U S E R    F L A G     T A B L E S'
*
*        FIRST HALF WORD OF USER FLAGS
*
*
* UH:FLG |---------------------------------|
*        |        |       |    1 1|1 1 1 1 |
*        | 0 1 2 3|4 5 6 7|8 9 0 1|2 3 4 5 |
*        |-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-|
*          | | | | | | | | | | | | | | | |
*          | | | | | | | | | | | | | | | > READY -READY TO RUN
*          | | | | | | | | | | | | | | > INTENTRY INHIBIT(RT)
*          | | | | | | | | | | | | | > :ACCTLG OR :USERS OPEN
*          | | | | | | | | | | | | > OPNCLS USER
*          | | | | | | | | | | | > PPSWAP-PURE PROCEDURE MUST BE SWAPPED
*          | | | | | | | | | | > INTERACTIVE USER
*          | | | | | | | | | > DELIC -DELTA IS IN CONTROL
*          | | | | | | | | > TELIC -TEL IS IN CONTROL
*          | | | | | | | > BATJOB-JOB IS A BATCH JOB
*          | | | | | | > JITIC -JIT IS IN CORE
*          | | | | | > DELASS-DELTA IS ASSOCIATED
*          | | | | > INIT -INITIALIZATION MUST BE DONE
*          | | | > SPEC. JIT ACCESS
*          | | > DCBS - INITIAL DCBS ARE BEING SWAPPED IN
*          | > STEP IN PROGRESS OR UNBLOCK RECEIVED BEFORE BLOCK EVENT
*          > BYPASS - AVAILABLE CORE IS TEMPORARILY TOO SMALL FOR USER
*
         PAGE
*
*        SECOND HALF-WORD OF USER FLAGS
*
*        FLAGS IN THIS GROUP ARE MOSTLY SWAPPER RELATED
*
*
* UH:FLG2|---------------------------------|
*        |        |       |    1 1|1 1 1 1 |
*        | 0 1 2 3|4 5 6 7|8 9 0 1|2 3 4 5 |
*        |-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-|
*          | | | | | | | | | | | | | | | |
*          | | | | | | | | | | | | | | | > JIT SWAP ERROR
*          | | | | | | | | | | | | | | > CONTEXT SWAP ERROR
*          | | | | | | | | | | | | | > USER SWAP ERROR
*          | | | | | | | | | | | | > SWAP QUANTUM NOT SATISFIED
*          | | | | | | | | | | | > JUST SWAPPED IN
*          | | | | | | | | | | > COC LINE HANG-UP
*          | | | | | | | | | > 9
*          | | | | | | | | > 8
*          | | | | | | | > TP FUNCTION
*          | | | | | | > INTERRUPTED DURING A CAL
*          | | | | | > SYSTEM GHOST LOCKED OUT (REAL TIME LOCK IN CORE)
*          | | | | > REAL TIME LOCK IN CORE (ABSOLUTE)
*          | | | > COC EVENT FOR TRANSACTION PROCESSING
*          | | > LOCK IN CORE FOR RMA (GENTLE)
*          | > COMMAND PROCESSOR BREAK
*          > 0
         PAGE
*
*        'DO' LIST POINTER - POINTS TO THE HEAD OF A SERIES OF
*                            LINKED FOUR WORD ENTRIES DEFINING
*                            SPECIAL ACTION TO TAKE WHEN RESCHEDULING
*                            USER OR EXITING A CAL.
*
*        FLAGS FOR ERROR, ABORT, CONTROL-Y AND BREAK ARE CONTAINED IN
*        BITS 0-3.
*
*
* UH:DL  |---------------------------------|
*        |        |       |    1 1|1 1 1 1 |
*        | 0 1 2 3|4 5 6 7|8 9 0 1|2 3 4 5 |
*        |-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-|
*          | | | |
*          | | | | <..... DA(DO LIST) .....>
*          | | | |
*          | | | > BRK - BREAK RECEIVED
*          | | > EC - CONTROL-Y RECEIVED
*          | > ERR - JOB IS TO BE ERRORED
*          > ABORT - JOB IS TO BE ABORTED
*
         PAGE
*
* LISTS OF Q'S FOR SELECTIONS
*
* Q'S TO CHOSE EXECUTION FROM
         BOUND    4
Y7D      DATA     X'7D000000'
*                                                                    RL3
SB:SWP   ESTS2    SWP,SW,STI,SC10,STOB,SQR,SQFI,SQA,SC9,SC8,SC7,;
                  SC6,SC5,SC4,SC3,SC2,SC1,SC0,SRT
         TITLE    'REPORT EVENT AND GIVE UP'
         USECT    TEL
         BOUND    4
         DEF      REG1
         REF      REG1PSD
         REF      REGIPSD           PSD FOR IOREG(MAPPED)
         DEF      T:IOREG
*
*        T:IOREG IS ENTERED VIA AN XPSD TO REGIPSD WITH
*                THE DCB ADDRESS IN R6.
*
*        ALL REGISTERS ARE PRESERVED.
*
*        DEPENDING ON CIRCUMSTANCE, THE USER MAY BE
*        SUSPENDED OR PERMITTED TO CONTINUE.
*
T:IOREG  PUSH     6,13              SAVE REGS
         LD,0     REGIPSD           GET CALLING PSD
         BAL,2    T:SAVE            SAVE ENVIRONMENT
         LI,1     X'1FFFF'          SCRUB DCB ADDRESS
         AND,1    6                 GET DCB ADDRESS
         LI,6     E:IIP             IO IN PROGRESS EVENT
         B        REG2              REPORT IT
         TITLE    'EXIT PATH CHECKS'
         SPACE    3
PULLEU   BDR,0    T:PULLE           BRANCH IF ENV IN MAPPED STACK
         LI,1     T:PULLE           SET RETURN TO PULL EXIT
         B        UNMAP             UNMAP THEN PULLEXIT
         SPACE    4
SSE41    SW,R13   U:MISC,R4         COMPUTE TIME SINCE SCHEDULED
         CW,R13   S:RTIR            AND CHECK FOR QMIN
*                                   S:RTIR WILL BE SET ZERO IF A
*                                   REAL TIME USER IS WAITING
         BL       PULLEU            NOT HAD IT AND NO RT USER WAITING
         LW,R15   SL:QMIN           RESET FLAG TO NORMAL QMIN VALUE
         STW,R15  S:RTIR            SINCE WE MAY HAVE HAD A RT USER
SSE42    LW,15    S:HIR
         BLEZ     PULLEU            NO HIGHER PRIORITY DUDES
         BDR,0    SSE43
         LI,0     SSE43             RETURN
*
*        MOVE USER'S ENVIRONMENT FROM UNMAPPED STACK
*        TO USER'S JIT BEFORE PARKING HIM.
*
*        R0 - LINK
*        R4 - USER NUMBER (PRESERVED)
*        ALL OTHER REGISTERS VOLATILE
*
*        EXITS MAPPED
*
SSE12    UNMAP
         LOAD,2   UX:JIT,4
         SLS,2    9
         LI,3     X'1FF'            MASK FOR PAGE DISP
         AI,2     TSTACK-J:JIT
         LI,8     19
         MSP,8    *2
         LS,2     0,2
         LI,3     -17
         AI,2     -17
         AW,3     TSTACK
         LCI      10
         LM,5     *M24,3
         STM,5    *M24,2
         LCI      9
         LM,5     9,3
         STM,5    9,2
         LD,8     *3
         BUMP     -19,5
         STD,8    *2
         LW,1     0
         B        MAP
SSE43    RES      0
         DISABLE                                 ***** DISABLE *****
         LB,R3    UB:US,R4          GET CURRENT STATE
         LB,R2    UB:PRIO,R4        GET CURRENT PRIO
         CW,R4    Y4                TEST FOR BOOST FLAG
         BAZ      %+2               NO, DONT ADD PRIO BOOST
         AW,R2    SL:SQPB           ADD SWAP QUAN THRESHOLD BOOST
         BAL,R11  CHSE0             AND PARK HIM
T:SEO    UNMAP                      SCHEDULE EXECUTION ONLY
         B        SEO               NO SWAP SCHEDULE NEEDED ON PARK
         TITLE    'TRAP AND INTERRUPT EXITS'
*************************************************
*                                               *
*            INTERRUPT EXIT POINTS              *
*                                               *
*            T:SSE - ALL INTERRUPTS BUT         *
*                    CLOCK 3                    *
*                                               *
*            T:SSEC - CLOCK 3                   *
*                                               *
*************************************************
         DEF      T:SSEC
         DEF      SSE0
         DEF      T:SSE
T:SSEC   EQU      %
T:SSE    EQU      %
         LI,11    SSE0              SET RETURN FROM T:SS
         B        T:SS              SWAP SCHEDULE
         DEF      TRAPEXIT,T:ACCTOV,T:SSEM
         PAGE
*************************************************
*                                               *
*         CAL AND TRAP EXIT POINT               *
*                                               *
*        TRAPEXIT - BUMPS RETURN ADDRESS        *
*                   IN PSD                      *
*                                               *
*        T:SSEM - PSD IS ALREADY CORRECT        *
*                                               *
*************************************************
*                                               *
*        SSE0 - ALTERNATIVE TO T:SSE FOR        *
*               I/O INTERRUPT TO AVOID          *
*               SUPERFLUOUS SWAP SCHEDULE       *
*                                               *
*************************************************
TRAPEXIT LW,1     TSTACK            TOP OF STACK ADDRESS
         AI,1     -17               POINT BACK TO PSD IN ENVIRONMENT
         AND,1    XN2               SCRUB OFF TO DOUBLE WORD BOUND
         MTW,1    0,1               ADVANCE TO CAL PLUS ONE
T:ACCTOV EQU      %
T:SSEM   EQU      %
SSE0     BAL,2    T:MASTER          CHECK FOR IMMEDIATE PULLE
SSE1     LAW,0    J:JIT             CHECK FOR UNMAPPED
         BNE      SSE11             MAPPED
         MAP                        GO MAPPED IF WE WERE UNMAPPED
SSE11    RES      0
         LW,4     S:CUN             GET CURRENT USER NUMBER
         LB,R1    J:RNST            GET RUN STATUS. CHECK IT AND
         CH,R1    UH:DL,R4          USER'S DO-LIST FOR THINGS TO DO.
         BCR,7    SSE5A             ---> NO ABNS OR DO-ITEMS (BOTH=0).
         LI,2     JB:FRS            GET FINAL RUN STATUS INDEX
         STB,1    0,2               SAVE RUN STATUS IN JIT FOR
*                                   ACCTSUM
         BDR,0    %+2               CHECK FOR UNMAPPED ENV
         BAL,0    SSE12             MOVE ENV FROM MTS TO UTS
         DISABLE                          ***** DISABLE *****
         LH,5     UH:DL,4           GET DO LIST
T:DOLIST EQU      %
         LH,R15   UH:FLG,R4         GET USER'S FLAGS IN R15.
         STH,R5   R13               R13(0-3)= ABRT,ERR,YC,BRK FLAGS.
         AND,5    M12               CLEAR FLAGS
         STH,5    UH:DL,4           REPLACE
         LC       13                GET FLAGS TO CONDITION CODES
         BCS,8    SEABRT            ABORT
         BCS,4    SEERR             ERROR
         LB,1     J:RNST
         BEZ      SSE8
         LI,2     X'FF'
         AND,2    J:JIT+ERO
         LB,14    J:ABC
         STB,2    14
         CI,15    TIC
         BAZ      T:TELDELCCI
SSE8     LC       13                GET FLAGS AGAIN
         BCS,2    SE9               CONTROL-Y
         BCS,1    SE7               BREAK
         AI,5     0                 CHECK FOR DOLIST ITEMS
         BEZ      SSE5              NO
         LD,6     0,5               GET FIRST DW OF ENTRY
         LB,0     6                 GET PRIORITY
         CB,0     UB:PRIOB,4        CHECK IT
         BG       SSE5              NOT NOW
         LH,1     6                 GET TYPE
         AND,1    M7                SCRUB
         CI,1     INTENT            CHECK FOR INTENTRY
         BNE      DOL1              NO
*        NOTE THAT CONTENT OF UH:FLG IS IN R15
         CI,R15   INHIBIT+TIC+DIC   ARE INTERRUPT ENTRIES ALLOWED
         BANZ     SSE5              NO
*                                   ALL OK, GO DO IT
         AND,R6   M12               SCRUB TO FLINK
DOL1     STH,R6   UH:DL,R4          STORE
         B        DOLV,1            SWITCH ON TYPE
DOLV     EQU      %-1               DO LIST TYPE VECTOR
         SREF     T:ECBSTORE
         B        T:ECBSTORE        1 => STORE ECB IN USER
         SREF     RT:INTENTRY
INTENTL  B        RT:INTENTRY       2 =.> INTERRUPT ENTRY
INTENT   EQU      INTENTL-DOLV      INTENTRY CODE
         SREF     COC:BRK
         B        COC:BRK           3 =.> SLAVELINE BREAK.
         SREF     COC:RDCOMP
         B        COC:RDCOMP        4 =.> SLAVELINE READ COMPLETE.
         SREF     COC:BRKLTR
         B        COC:BRKLTR        5 =.> SLAVELINE BREAK LATER.
         SREF     COC:WTCOMP
         B        COC:WTCOMP        6 =.> SLAVELINE WRITE COMPLETE.
*
         B        *R7               7 =.> SPECIAL ACTION ROUTINE.
*
*        DO-LIST PROCESSING ROUTINES ARE CALLED WITH:
*                 R4 = S:CUN (CURRENT USER NUMBER).
*                 R5 = DA(DO-LIST BLOCK).
*                 R6/7 = FIRST DW OF DO-LIST BLOCK.
*                         (EXCEPT FOR R/T INTENTRY ROUTINE)
*                 R15 = UH:FLG (USER'S FLAGS).
*        REGISTERS 4 AND 5 MUST BE PRESERVED BY PROCESSING ROUTINE.
*        PROCESSING ROUTINE SHOULD RETURN TO T:DOLISTR.
*
         DEF      T:DOLISTR
         DEF      T:DLR1
T:DOLISTR EQU     %                 RETURN FROM DO LIST PROCESSOR
         LD,6     0,5               GET FIRST DW AGAIN
         CW,6     Y008              TEST INHIBIT RELEASE BIT
         BANZ     T:DLR1            SET, DONT RELEASE
         LW,2     5                 POINT TO BLOCK
         SLS,2    1                 WORD ADDRESS
         BAL,1    ECBFBLK           RETURN BLOCK TO POOL
T:DLR1   RES      0
         DISABLE                           ***** DISABLE *****
         LH,5     UH:DL,4           GET DO LIST AGAIN
         BNE      T:DOLIST          DO IT
SSE5     LI,0     4                 SET DONT-COPY-CONTEXT FLAG AGAIN.
SSE5A    ENABLE                       ***** ENABLE *****
         LW,13    J:DELTAT
         AW,13    J:OVHTIM
         AW,13    J:CTIME
         SW,13    J:IDELTAT
         CW,R13   SL:SQNT           ARE WE NEARING THE END OF SQUAN?
         BL       SSE6              NO
         OR,R4    Y4                SET FLAG TO TRIGGER PRIO BOOST
         CW,13    SL:SQUAN
         BL       SSE6              NOT HAD SQUAN YET
         DISABLE
         LH,R14   UH:FLG2,R4        GET SECOND FLAGS
         CI,R14   SQUAN             CHECK FOR RESET
         BAZ      SSE6E             YES
         MTW,+1   S:SEVF            SWAP SET CHANGED
         AND,R14  XFFF7             RESET SQUAN FLAG
         STH,R14  UH:FLG2,R4        AND SAVE NEW FLAGS
SSE6E    ENABLE
         AND,R4   M8                RESET BOOST FLAG
SSE6     AW,R13   J:IDELTAT         NOW CHECK FOR QUANTUM END
         BLZ      SSE41             NOT YET
         BDR,R0   %+2               CHECK FOR ENV IN UNMAPPED JIT
         BAL,R0   SSE12             YES, MOVE TO USER JIT
         BAL,R3   T:ACCTEX          GIVE NEW QUAN
         LW,4     S:CUN             RESTORE CURRENT USER NUMBER
         LB,5     UB:PRIOB,4        GET BASE PRIO
         STB,5    UB:PRIO,4         MAKE IT CURRENT
         DISABLE                                 ***** DISABLE ****
         LB,3     UB:US,4           GET UUSERS CURRENT STATE
         LH,15    UH:FLG,4          GET USER FLAGS.
         MTW,+1   S:SEVF            BUMP SWAP SET CHANGE CTR
         BAL,11   T:CHSE0           TAIL OF HIS COMPUTE Q
*        B        T:SE              FALL THROUGH TO SCHEDULE
*
*
*        USER HAS QUANTUM ENDED AND BEEN DROPPED BACK TO HIS
*        BASE EXECUTION PRIORITY.
*
         TITLE    'E X E C U T I O N    S C H E D U L E R'
         DEF      T:SE
T:SE     EQU      %
         SPACE    1
***************************************************
*                                                 *
*             SCHEDULE FOR EXECUTION              *
*                                                 *
*        BOTH A SWAP SCHEDULE ATTEMPT AND         *
*        A CALL TO SACT ARE MADE BEFORE           *
*        SCHEDULING ANOTHER USER.                 *
*                                                 *
***************************************************
         SPACE    1
         UNMAP
         BAL,11   T:SS
         BAL,11   SACT              GOOSE THE SYMBIONTS
SEO      BAL,R11  T:SES             SCHEDULE EXECUTION FOR SLAVES
         LI,15    1
         LW,R14   S:EVF             GET EVENT FLAG COUNTER
         REF      M6
         LD,2     SB:HQ             GET FIRST SEVEN STATES
         BEZ      SEF1              NONE, SKIP FIRST SEVEN
         OR,2     Y7D               SET EXPONENT FOR FLOATING SHIFT
         SFL,2    16                DO NORMALIZE TO FIND FIRST FULL STATE
         SCS,2    7                 COUNT=COUNT/2
         AND,2    M6                SCRUB
         EOR,2    M6                INVERT TO FORM INDEX
         B        %+2
SEF1     LI,2     8                 START WITH EIGHTH STATE
SIC1     RES      0
         LB,4     SB:HQ,2           GET HEAD OF STATE QUEUE
         BEZ      SIC3
SIC2     CH,15    UH:FLG,4          IN CORE?
         BANZ     SE1               IF SO LETS RUN HIM
         LB,R4    UB:FL,R4          NEXT USER IN QUEUE
         BNEZ     SIC2
SIC3     AI,2     1                 NEXT STATE
         CI,2     SEXU              ONLY LOOK AT EXU STATES
         BLE      SIC1              CONTINUE
         LI,1     X'FF'             CLEAR CURRENT PRIORITY
         STW,1    S:CUP             FOR S:HIR TESTS
         SREF     RAPURGE
         LI,0     %+3               SET RETURN
         LI,2     RAPURGE
         BNEZ     0,2               GO RELEASE READ-AHEAD PAGES IF POSSIBLE
         LW,1     S:CUIS
         AW,1     GOODNGT
         REF      GOODNGT
         BG       IDL1
         LB,5     SNDDX
         AI,5     -2
         REF      SSTAT
IDL0     EQU      %
         LB,7     SSTAT,5
         BEZ      %+3
         CI,7     1
         BE       IDL1
         LB,7     SSIG,5
         CI,7     'I'
         BE       IDL1
         BDR,5    IDL0
         LW,R5    Y004              GET DELAY COUNT
         BDR,R5   %                 AND WAIT 5 SECONDS
*                                   TO PERMIT COC OUTPUT
         SCREECH  X'404'
IDL1     EQU      %
         ENABLE
         LW,1     S:SIP             CHECK FOR SWAP IN PROGRESS
         LH,2     SB:HQ+(SIOW/4)    CHECK FOR BOTH KINDS OF I/O WAIT
         BEZ      %+2               NO I/O WAIT
         AI,1     2                 SET I/O BIT
         LH,0     C:IDL,1           GET COUNTER ADDRESS
         LF       F:IDL,1           SET FLOATING MODE BITS
         STW,R0   S:CLOCK4          SET CLOCK TO ACCOUNT IDLE
         LW,0     C:TINC            CHECK TIME OF DAY CLOCK
         BG       %+3               -POSITIVE,YUP AOK
         LI,5     X'80'             -NEG,BAD  SO
         WD,5     X'1700'           ... TRIGGER HIM
*                                   FALL THROUGH TO IDLE LOOP
         PAGE
***********************************************************************
*                                                                     *
*                    I D L E     L O O P                              *
*                                                                     *
*              THE REASON FOR BEING IDLE IS DISPLAYED                 *
*              IN THE FLOATING MODE CONTROL BITS OF                   *
*              THE PROGRAM STATUS DOUBLEWORD:                         *
*                                                                     *
*                  F  F  F                                            *
*                  S  Z  N                                            *
*                  -  -  -                                            *
*                  1  0  0     =>    PURE IDLE, NOTHING TO DO
*                  0  0  1     =>    IDLE WITH SWAP IN PROGRESS       *
*                  0  1  1     =>    IDLE WITH I/O AND SWAP IN PROGRESS
*                  1  1  0     =>    IDLE WITH I/O IN PROGRESS        *
*                                                                     *
***********************************************************************
         SPACE    2
         WAIT,0   0                 *** IDLE LOOP ***
         SPACE    2
*                                   DRIVEN OUT OF WAIT BY INTERRUPTS
*                                   AT LEAST EVERY 2 MILLISECONDS
*                                   FALLING THROUGH TO SCHEDULE FOR
*                                   BOTH SWAPS AND EXECUTION
         B        T:SE              GO SCHEDULE AGAIN
C:IDL    DATA,2   C:IDLE,C:IDLES,C:IDLEW,C:IDLESW
F:IDL    DATA,1   4,1,6,3
         REF      C:IDLEW,C:IDLESW
         TITLE    'PLACE USER IN EXECUTION'
SE1      EQU      %                RETURN HERE FROM SIC WITH A USER
*
**************************************************
*                                                *
*             LOAD MAP AND ACCESS                *
*                                                *
**************************************************
         SPACE    2
         STW,R4   S:CUN             DECLARE CURRENT USER NUMBER
         LOAD,11  UX:JIT,4          GET JIT PAGE NUMBER
         SLS,11   9                 AND MAKE IT WORD ADDRESS
         LD,8     S:ACCW            GET SKELETON CW FOR ACCES
         OR,8     11                MERGE IN PHYS PAGE
         LPC,8    0                 LOAD ACCESS LOCKS
         LD,8     S:MAPCW           GET SKELETON FOR LOADING MAP
         OR,8     11                MERGE PAGE OF JIT
         LDMAP,8  0                 LOAD ENTIRE MAP
         DISABLE
         LH,R15   UH:FLG,R4         GET FLAGS
         CI,R15   RTR               MAKE SURE SWAPPER DIDN'T STEAL HIM
         BAZ      T:SE              YES IT DID, RECYCLE
         CI,15    SJAC              CHECK FOR SPECIAL JIT ACCESS
         BAZ      %+3               NONE
         LD,8     S:SJACCW          GET CONTROL WORD
         LPC,8    0                 AND LOAD JIT ACCESS
         LB,3     UB:US,4           GET CURRENT STATE
         LI,2     SCU
         LB,5     UB:PRIO,4         GET USERS PRIORITY
         CB,R5    UB:PRIOB,R4       IS HE AT BASE
         BGE      %+3               YES, DONT DECREMENT
         AW,R5    S:PRIODEC         DECREMENT CURRENT PRIO
         STB,R5   UB:PRIO,R4        SAVE NEW PRIO
         STW,5    S:CUP             ANNOUNCE IT
         MTW,-1   S:HIR             ONE LES HIR
         BAL,11   RCE4              CHANGE STATE TO SCU  ***** ENABLE *****
         MAP
         LH,14    UH:FLG2,4         GET SECOND FLAGS
         AND,14   XFDFF             RESET CAL INTERRUPT BIT
         CI,14    7                 CHECK FOR SWAP ERRORS
         BAZ      SE4D              NONE
         SLD,14   -3                ERROR FLAGS TO R15
         SLS,14   3                 CLEAR FLAGS
         STH,14   UH:FLG2,4         SAVE NEW FLAGS
         LC       15                GET SWAP ERROR FLAGS
         BCS,4    T:DELUSZAP        OFF THIS USER - CONTEXT ERROR
         BCR,2    SE4D1             USER AREA ERROR
         LW,5     S:CUN             USER NUMBER
         B        T:SCRATCH%USER
SE4D1    DISABLE                            ***** DISABLE *****
         LH,R6    UH:DL,R4          GET DO LIST
         OR,6     X4000             SET ERROR FLAG
         STH,6    UH:DL,4           SAVE
         ENABLE                             ***** ENABLE *****
SE4D     EQU      %
         DO       PERFORM
         BAL,6    ACTIVATE
         FIN
         CI,R14   SWAPD             CHECK FOR JUST SWAPPED IN
         BAZ      SE4F              NO
         AND,R14  XFFEF             CLEAR THE JUST SWAPPED IN FLAG
XFFEF    EQU      NB31TO0+5
XFFF7    EQU      NB31TO0+4
         BAL,3    T:ACCTEX          ACCOUNT EXEC TIME UP TO NOW
         LW,4     S:CUN
         STH,14   UH:FLG2,4         SAVE SECOND FLAGS
SE4F     LI,R0    J:OVHTIM          SET CLOCK TO OVERHEAD
         STW,R0   S:CLOCK4          AND SET IN CLOCK POINTER
         LW,R13   J:DELTAT          COMPUTE
         AW,R13   J:OVHTIM           EFFECTIVE
         AW,R13   J:CTIME             QUANTUM
         STW,R13  U:MISC,R4         SAVE IN MISC
         BAL,2    T:MASTER
         LH,5     UH:DL,4           GET DO LIST
         BNE      SSE1              GO DECODE
         LW,10    J:TIMENT          GET STIMER ENTRY ADDRESS.
         BEZ      T:PULLE           NONE
         LW,2     J:UTIMER          CHECK TIMER
         BGZ      T:PULLE           NOT UP YET
         LI,0     0
         STW,0    J:TIMENT          ONLY ONE ENTRY PER CAL.
         B        ALTENT            GO TO STIMER ENTRY ADDRESS
         PAGE
SEABRT   RES      0
T:OFF    LW,1     J:ACCN
         BNEZ     OFF10
         LW,1     SYSACT+1          GET BLANKS
         STW,1    J:ACCN
OFF10    RES      0
         LW,4     S:CUN             CHECK IF THIS IS
         LH,1     UH:FLG2,4         A LINE-HANGUP USER
         CI,R1    HANGUP            CHECK FOR HANGUP FLAG
         LI,R1    X'10'             ASSUME NOT (CC2 UNCHANGED)
         BAZ      NOTLNF            NOT HANGUP, RNST = X'10'
         LI,R1    8                 LINE HANGUP, RNST = X'08'
NOTLNF   RES      0
         STB,1    J:RNST
         LI,R13   TIC+BAT           TEL IN CONTROL AND BATCH FLAGS
         CS,R13   R15               CHECK FOR PRE CCI ABORT
         BNE      T:TELDELCCI       NO, EXIT.
         B        SSE5              YES, IGNORE FOR NOW
SEERR    RES      0
         ENABLE
         LI,1     3
         STW,1    J:JIT+ERO
         LI,14    X'B4'
         LI,1     X'20'
         B        SETRNST
         REF      SETRNST
         PAGE
         DEF      DELTAGO
DELTAGO  RES      0
*                 GO TO DELTA.  BRING DELTA INTO CORE IF NECESSARY.
*                 ASSUMES DELTA ASSOCIATED, NOT TEL-IN-CONTROL.
*                 REGISTERS MUST BE SET AS FOLLOWS:
*                 R10 = DELTA ENTRY ADDRESS.
*                 R4  = USER NUMBER. (CURRENT USER).
*                 R15 = USER'S FLAGS (UH:FLG).  DELA SET, TIC RESET.
*                 R0 CONTENTS GO INTO TOP WORD OF DELTA'S STACK AFTER
*                       COPYING TSTACK CONTEXT TO DELTA'S STACK.
         CI,15    DIC               DIC = DELTA IN CORE & ACCESSIBLE.
         BANZ     DELTAIN           ---> SO JUST DO THE STACK COPY.
         SETST    DIC               IF NOT DIC, WE'LL MAKE IT SO.
         LB,2     UB:ASP,4          ASP NONZERO = DELTA NOT AROUND.
         BEZ      DELNOASP          ---> NO ASP; DELTA'S IN CORE NOW.
         RSETST   RTR               HAVE ASP, SO MUST FETCH DELTA.
         MTB,-1   PB:UC,2           DECREMENT ASP (LIBRARY) USE COUNT.
         LH,14    UH:FLG2,4
         CI,14    X'800'            LOCKED IN CORE
         BAZ      NOLCT             NO
         MTB,-1   PB:LCT,2          STILL LOCKED
         BG       NOLCT             YES
         LB,2     PB:PSZ,2          NO, GET PSZ
         LCW,2    2                 AND TAKE IT
         AWM,2    S:RTCORE          FROM RTCORE
NOLCT    BAL,2    IDB
         LI,6     E:AP
         BAL,11   T:REG             READ DELTA INTO CORE.
         CI,14    X'800'            LOCKED IN CORE
         BAZ      DELNOASP          NO
         MTB,0    PB:LCT,1          ALREADY LOCKED
         BG       %+3               YES
         LB,14    PB:PSZ,1          NO, GET PSZ
         AWM,14   S:RTCORE          AND ADD IT IN
         MTB,1    PB:LCT,1
DELNOASP LW,6     0                   (SAVE R0 ACROSS T:PAC)
         BAL,11   T:PAC             LOAD DELTA'S ACCESS-PROTECTION.
         LW,0     6                   (RESTORE R0)
DELTAIN  LI,1     SPDBASE           R1 => DELTA'S STACK.
         LD,12    19SPD
         STD,12   TSTACK            CRANK STACK DOWN TO ONE ENVIRN.
         LW,6     10                SAVE ENTRY ADDR ACROSS T:UTSXTS.
         BAL,4    T:UTSXTS          COPY TSTACK TO DELTA STACK.
         LI,3     TSTACK+3          (SET R3 IF DELTA STACK IS EVIL).
         OR,6     SMPSD             BUILD A   R E L I A B L E   PSD
         LW,7     SMPSD+1           AROUND DELTA'S ENTRY ADDRESS
         STD,6    *3                AND INSTALL IN TSTACK.
         LB,R8    J:RNST
         STW,R8   R8+2,3            PUT RNST INTO R8 IN TSTACK.
         LI,R8    0
         STB,R8   J:RNST            ZERO OUT RNST.
         B        T:SSEM          -----> RESCHEDULE, THEN GOTO DELTA.
*
SE7      LI,0     -1                BREAK. R0= CODE FOR BREAK (-1).
         CI,15    TIC               TIC = COMMAND PROCESSOR IN CONTROL
         BANZ     SE6               ---> GO IF C.P. IN CONTROL.
         CI,15    DELA              DELA = DELTA ASSOCIATED.
         BAZ      SE6A              ---> GO IF USERCONTROL, NODELTA.
         LI,10    SPPBASE+X'D'      R10= DELTA BREAK ENTRY ADDRESS.
         B        DELTAGO         -----> GO TO DELTA.
         DEF      SE7A              SLAVELINE BREAK. R0= LINE NUMBER.
SE7A     CI,15    TIC               TIC = COMMAND PROCESSOR IN CONTROL.
         BAZ      SE6A              ---> GO IF USER IN CONTROL.
SE6      LC       J:INTENT          SEE IF C.P. HAS BREAK CONTROL.
         BCR,4    T:SSEM            ---> NO. IGNORE BREAK.
SE6A     LW,10    J:INTENT          R10= USER/C.P. BREAK ADDRESS.
         BNEZ     ALTENT            ---> IF M:INT, GO TO USER/C.P.
*
SE9      CI,15    TIC               CTL-Y, OR BREAK WITH NO M:INT.
         BANZ     T:SSEM            --> IGNORE IF C.P. IN CONTROL.
         LH,2     UH:FLG2,4
         CI,2     RTHOLD            IS USER 'LOCKED-IN-CORE'?
         BANZ     T:SSEM            YES...IGNORE 'YC'/'BREAK'
         LI,1     2                 TELL C.P. THAT
         STS,1    J:TELFLGS           BRK/YC RECEIVED.
         B        T:ECCP
         REF      T:ECCP
*
ALTENT   RES      0     (R0=USERSTACK FLAGWORD, R10=USERROUTINE ADDR)
         LW,1     J:TCB             BREAK/TIMEOUT WITH USER CONTROL.
         LI,11    X'1FFFF'          COPY ADDR ONLY INTO TSTACK PSD.
         BAL,4    T:UTSXTS          COPY TSTACK TO USER TCB STACK.
         B        ALTERR            ---> ERROR IN USER STACK.
         B        T:PULLE           GO TO USER.
*
ALTERR   LI,14    X'A3'             *** ERROR IN BREAK/STIMER.
         B        T:ABORTM          ***
         TITLE    'REPORT EVENT AND GIVE UP CONTROL'
*
*        T:REG    REPORT EVENT AND GIVE UP
*
*        R6 - EVENT NUMBER
*        R11 - LINK
*        ALL REGISTERS PRESERVED
*
*        T:REG MUST BE CALLED MAPPED AS IT ASSUMES THAT
*        WE MAY BLOCK THE CURRENT USER FOR SOME UNSATISFIED
*        CONDITION.  THE ENVIRIONMENT EXISTING AT THE TIME
*        T:REG IS CALLED IS SAVE IN THE CURRENT USER'S JIT
*        AND THEN THE EVENT IS REPORTED.  SOME EVENT-
*        CIRCUMSTANCE COMBINATIONS WILL CAUSE AN IMMEDIATE
*        T:PULLE.  NORMALLY, HOWEVER THE USER WILL BE SUSPENDED
*        AND A NEW USER SCHEDULED AT T:SE.
*
         DEF      T:REG
T:REG    XPSD,0   REG1PSD           GET CURRENT PSD AND GO MAPPED
REG1     PUSH     6,13              SAVE 13,14,15,0,1,2
         LW,R0    R11               RETURN
         LI,R1    X'E0000'          MASK IT INTO
         LS,R0    REG1PSD           PSD
         LW,R1    REG1PSD+1         GET SECOND HALF
         BAL,R2   T:SAVE            SAVE ENVIRIONMENT
REG2     BAL,R2   T:SMPFLG          SET MASTER ONLY FLAG
         LI,R11   T:SE              SET RETURN TO SCHEDULE
*                                   RE-SCHEDULE
*
*        T:RE  REPORT EVENT FOR CURRENT USER
*
*        R11 - LINK
*        R6 - EVENT (MODIFIED)
*        ALL OTHER REGISTERS VOLATILE
*
T:RE     LW,R4    S:CUN             GET CURRENT USER NUMBER
*        B        RCE0              WADE INTO EVENT REPORTING
         TITLE    'E V E N T    R E P O R T I N G '
*                                   T:RCE - REPORT COC EVENT
*                                   T:RE - REPORT EVENT FOR CURRENT
*                                            USER
*                                   T:RUE - REPORT EVENT FOR SPECIFIED
*                                            USER
*                                   7 = LINE# (RCE ONLY)
*                                   6 = EVENT#
*                                   5 = USER# (RUE ONLY)
RCE0     DISABLE                    EVENT REPORTING MUST BE DONE
         MTW,+1   S:EVF             SET EVENT FLAG-COUNTER
*                                   DISABLED
         LB,3     UB:US,4           GET CURRENT STATE
         LW,12    X1,3              GET BIT CORRESPONDING TO IT
RCE1     CW,12    S:SET,6           ARE WE AT THE RIGHT PLACE
         BANZ     RCE3              YES
         LW,15    S:SET,6           CHECK FOR CONTINUATION
         BLZ      RCE2              YES
         SCREECH  X'02'             BAD STATE EVENT COMBINATION
*S*********************************************************************
*S*                                                                   *
*S*      SCREECH CODE: 02           CALLED FROM SCHED                 *
*S*      MESSAGE: USER'S STATE AND EVENT ARE INCONSISTENT             *
*S*      SIGNIFICANT REGISTERS:                                       *
*S*               R3 - USER'S CURRENT STATE                           *
*S*               R4 - USER NUMBER                                    *
*S*               R6 - EVENT NUMBER (MAY HAVE BEEN INCREMENTED)       *
*S*              R11 - RETURN ADDRESS FOR EVENT REPORTING             *
*S*              R12 - BIT CORRESPONDING TO CURRENT STATE             *
*S*              R15 - REGISTER USED FOR CONTINUATION CHECK           *
*S*                    BIT 0 WILL BE EQUAL TO ZERO                    *
*S*      REMARKS: USUALLY A SOFTWARE CHECK 02 INDICATES THAT SOME     *
*S*               PIECE OF THE SYSTEM PASSED BAD ARGUMENTS TO T:RE,   *
*S*               T:REG OR T:RUE.  THE SOLUTION TO THE PROBLEM WILL   *
*S*               GENERALLY COME FROM DETERMINING WHO CALLED THE      *
*S*               EVENT REPORTING LOGIC AND WHY.                      *
*S*********************************************************************
RCE2     AI,6     1                 NEXT ENTRY
         B        RCE1              CONTINUE
RCE3     LB,2     SB:SET,6          GET ACTION CODE
         LH,15    UH:FLG,4          GET FLAGS FOR MANY ST EVENTS
         CI,2     SNSTS             CHECK FOR SPECIAL ACTION
         BG       S:TRNSVEC-X'20',2 YES GO TO IT
*
*        STATE CHANGE FOR NON-EXECUTABLE STATES
*
RCE4     LB,5     UB:BL,4           GET BACK LINK
         LB,1     UB:FL,4           AND FORWARD LINK
         BNEZ     %+2               NOT TAIL
         STB,5    SB:TQ,3           SET NEW TAIL
         AI,5     0                 CHECK FOR HEAD
         BNEZ     %+2               NO
         STB,1    SB:HQ,3           SET NEW HEAD
         STB,5    UB:BL,1           CROSS LINK
         STB,1    UB:FL,5           REMAINING QUEUE MEMBERS
         LI,1     0                 ZAPPER
         AI,4     0                 CHECK FOR QUEUE TO HEAD
         BLZ      T:QH              YES
T:QT     STB,1    UB:FL,4           ZAP FLINK SINCE WE ARE AT TAIL
         LB,1     SB:TQ,2           GET PREVIOUS TAIL
         BEZ      CHSE25            EMPTY QUEUE
         STB,4    SB:TQ,2           SET NEW TAIL
         STB,1    UB:BL,4           BACK LINK TO PREVIOUS TAIL
         STB,4    UB:FL,1           AND MAKE HIM POINT TO NEW GUY
         B        CHS1              DONE
T:QH     STB,1    UB:BL,4           SET BACK LINK TO ZERO
         LB,1     SB:HQ,2           GET CURRENT HEAD
         BEZ      CHSE25            EMPTY QUEUE
         STB,4    SB:HQ,2           AND SET NEW HEAD
         STB,4    UB:BL,1           SET BLINK TO PREVIOUS HEAD
         STB,1    UB:FL,4           SET FLINK TO PREVIOUS  HEAD
         B        CHS1              DONE
         TITLE    'EXECUTABLE STATE CHANGE'
*
*        CHANGE STATE FOR EXECUTABLE STATES
*
*        R1 - PRIORITY INCREMENT INDEX, DESTROYED
*                 0 => NONE  (OLD SCOM)
*                 1 => S:SCPINC (OLD SC)
*                 2 => S:IOCPINC (OLD SIOC)
*                 3 => S:IRPINC (OLD SIR,SEC,SBK,SON,SOFF)
*        R2 - TEMP, NEW STATE
*        R3 - OLD STATE
*        R4 - USER NUMBER
*                 QUEUE TO HEAD IF BIT 0 IS SET
*        R5 - TEMP, USER PRIORITY
*        R11 - LINK  EXIT WILL ENABLE
*        R15 - USER FLAGS (UH:FLG)
*        THESE ROUTINES MUST BE CALLED DISABLED
*
T:CHSE0  LI,1     STSC              SET INDEX TO ZERO (BASE COMPUTE)
T:CHSE   LB,2     UB:PRIOB,4        GET CURRENT PRIORITY
         CI,R15   OPNCLSUSR+SPECFILE   CHECK FOR EXTRA BOOST
         BAZ      %+2               NO, NOTHING SPECIAL FOR HIM
         AI,2     -OPNBOOST         YES, GIVE HIM AN EXTRA SHOT
         AI,1     -STSC             SUBTRACT BASE ADDRESS
         SH,2     SH:PINC,1         ADD PROPER PRIORITY INCREMENT
CHSE0    STB,2    UB:PRIO,4         REMEMBER NEW VALUE
         CW,2     S:CUP             GREATER THAN CURRENT USER
         BGE      CHSE1             NO, DONT SET S:HIR
         CI,15    1                 IF HE IS IN CORE
         BAZ      CHSE1             NO
         MTW,1    S:HIR             GOT A HIGH PRIO GUY
         BG       CHSE1             POSITIVE IS OK
         LI,1     1                 ELSE FORCE TO ONE
         STW,1    S:HIR             IF 0 OR NEGATIVE
CHSE1    AI,2     -X'F5'            PRIO FOR STATE SC0
         BG       CHSE6             CHANGE STATE TO SC1 - SC10
         AI,2     X'F5'-X'C0'       CHECK FOR REAL TIME
         BL       CHSRT             YES
         LI,2     SC0               QUEUE INTO SC0 FOR HIGH PRIO BGRD
CHSE2    LB,5     UB:BL,4           GET BLINK *
         LB,1     UB:FL,4           AND FLINK  *
         BNEZ     %+2               NOT AT TAIL * UNLINK
         STB,5    SB:TQ,3           SET NEW TAIL *
         AI,5     0                 CHECK FOR AT HEAD
         BNEZ     %+2               NO
         STB,1    SB:HQ,3           YES, SET NEW HEAD
         STB,1    UB:FL,5           CROSS LINK REMAINING MEMBERS
         STB,5    UB:BL,1           IN OLD STATE QUEUE
         LB,5     UB:PRIO,4         GET PRIORITY
         AI,4     0                 CHECK FOR QUEUE TO HEAD
         BLZ      CHSEH             YES
         LB,1     SB:TQ,2           GET TAIL OF NEW QUEUE
         BNE      CHSE3             NOT EMPTY
CHSE25   STB,1    UB:BL,4           NULL QUEUE
         STB,1    UB:FL,4           ZAP LINKS
         STB,4    SB:TQ,2           SET HEAD AND
         STB,4    SB:HQ,2           TAIL POINTERS
         B        CHS1              EXIT
CHSE3    CB,5     UB:PRIO,1         COMPARE PRIORITIES
         BGE      CHSE4             THIS IS THE PLACE
         LB,1     UB:BL,1           BLINK BACK
         BNE      CHSE3             AND TRY AGAIN
         B        T:QH              AT THE HEAD OF THIS Q
CHSE4    STB,1    UB:BL,4           SET BACK LINK
         LB,5     UB:FL,1           GET FORWARD
         BNEZ     CHSE5             NOT AT TAIL
         STB,4    SB:TQ,2           SET NEW TAIL
         STB,5    UB:FL,4           ZAP FORWARD LINK
         STB,4    UB:FL,1           LINK TO PREVIOUS TAIL
         B        CHS1              EXIT
CHSE5    STB,4    UB:BL,5           SET BLINK FOR NEXT GUY
         STB,5    UB:FL,4           AND POINT TO HIM
         STB,4    UB:FL,1           LINK TO PREVIOUS GUY
         B        CHS1
CHSRT    RES      0                 GOT  A REAL TIME GUY
         LI,2     SRT               STATE REAL TIME
         LB,5     UB:PRIOB,4        GET BASE PRIORITY
         STB,5    UB:PRIO,4         AND MAKE IT CURRENT - DONT FLOAT RT
         B        CHSE2             CHAIN HIM IN
CHSEH    LB,1     SB:HQ,2           GET CURRENT HEAD
         BEZ      CHSE25            NULL QUEUE
CHSEH1   CB,5     UB:PRIO,1         COMPARE PRIORITIES
         BL       CHSEH2            AT THE RIGHT SPOT NOW
         LB,1     UB:FL,1           FLINK ON
         BNE      CHSEH1            AND COMPARE AGAIN
         B        T:QT              WE GO ON THE TAIL
CHSEH2   STB,1    UB:FL,4           SET NEW FORWARD LINK
         LB,5     UB:BL,1           GET HIS OLD BACK LINK
         BNEZ     CHSEH3            NOT AT HEAD
         STB,4    SB:HQ,2           SET NEW HEAD
         STB,5    UB:BL,4           ZAP BLINK
         STB,4    UB:BL,1           MAKE HIM POINT BACK
         B        CHS1              EXIT
CHSEH3   STB,4    UB:FL,5           MAKE PREVIOUS GUY POINT TO US
         STB,5    UB:BL,4           POINT BACK AT HIM
         STB,4    UB:BL,1           SET NEXT GUYS BLINK TO US
         B        CHS1              EXIT
*
T:CHS    DISABLE
         B        RCE4
CHSE6    AI,R2    SC0               ADD IN BASE STATE NUMBER
         B        RCE4              AND DO SIMPLE STATE CHANGE
         TITLE    'S P E C I A L     T R A N S I T I O N S'
*
* SPECIAL ROUTINES FOR RE
*
S:TRNSVEC EQU     %
STSCOM   BAL,1    T:CHSE            COMPUTE
STSC     BAL,1    T:CHSE            SPECIAL COMPUTE
STIOCC   BAL,1    T:CHSE            I/O COMPLETE
STIRC    BAL,1    INTERACTIVE       INTERACTIVE
STOC     EQU      STIOCC            TERMINAL OUTPUT CONTINUE
INTERACTIVE EQU   %
         OR,15    X20               SET INTERACTIVE BIT
         STH,15   UH:FLG,4          IN FLAGS
         B        T:CHSE            AND CHANGE STATE
         SPACE    1
*        BLOCK FOR I/O IN PROGRESS OR MF TOO HIGH
         SPACE    1
STIOMF   LI,R1    0                 ZERO DCB TO FORCE BLOCK
STIIP    EQU      %                 I/O IN PROGRESS
         LB,2     UB:MF,4
         BEZ      GRANT             I/O IS ALLREADY DONE
         LI,R11   T:SEO             CHANGE RETURN TO AVOID T:SS
         AI,6     SIOW-E:IIP        FORM PROPER STATE NUMBER
         LW,2     6                 MOVE TO PROPER REGISTER
         AI,1     0                 CHECK FOR NEWQ (DCBADDR =0)
         BEZ      RCE4              NEWQ
FCN      EQU      7
         LW,8     FCN,1             GET FUNCTION COUNT WORD
         CW,8     YFF               TEST FOR ZERO FUNCTIO COUNT
         BAZ      GRANT             YES, LET HIM GO
         CI,1     M:OC              DONT FLAG M:OC
         BE       RCE4              YES IT IS M:OC, STATE CHANGE ONLY
         OR,8     Y8                SET MARKER BIT IN FCN WORD OF DCB
         STW,8    FCN,1             AND REPLACE IT
         B        RCE4              PARK HIM
         SPACE    1
*        I/O COMPLETE REPORT HANDLING
         SPACE    1
STIOC    EQU      %                 I/O COMPLETE
         MTB,-1   UB:MF,4           DECREMENT MASTER FUNCTION COUNT
         CW,12    =(1**SIOW)+(1**SIOMF)
         BAZ      ENBISR4           NOT WAITING, GET OUT
         LB,R0    UB:MF,R4          CHECK FOR ALL I/O COMPLETE
         BEZ      IOCOM3            YES
         CI,3     SIOMF             CHECK FO MASTER FUNCTION COUNT BLOCK
         BE       IOCOM2            YES, WITH I/O GOING
IOCOM1   AND,R1   M21               SCRUB DCB PHYSICAL ADDRESS
         BEZ      STIOCC            NO DCB, NEWQ
         CI,R1    M:OC              ALWAYS UNBLOCK M:OC
         BE       STIOCC            YES
         LW,R2    FCN,R1            GET FUNCTION COUNT WORD
         BGEZ     IOCOM4            NOT WAITING ON THIS ONE
         CW,R2    Y7F               CHECK FOR ZERO FCN
         BANZ     IOCOM4            NO, DONT UNBLOCK YET
IOCOM5   AND,R2   M24               SCRUB FLAG OFF
         STW,R2   FCN,R1            REPLACE FCN WORD WITH FLAG OFF
         B        STIOCC            AND UNBLOCK
IOCOM2   LW,2     SL:OIMF           GET ONLINE UNBLOCK
         CI,15    BAT               CHECK FOR BATCH
         BAZ      %+2               NO
         LW,2     SL:BIMF           YES, USE BATCH LIMIT
         CB,2     UB:MF,4           SHOULD WE RESTART HIM
         BL       ENBISR4           NO
IOCOM3   MTW,+1   S:SEVF            SWAP SET CHANGED
         CI,R3    SIOMF             BLOCKED FOR MASTER FUNCTION COUNT?
         BNE      IOCOM1            NO
         B        STIOCC            TURN HIM LOOSE
IOCOM4   LB,R0    UB:MF,R4          GET MF AGAIN
         BNE      ENBISR4           STILL GOT I/O GOING
         B        IOCOM5            AND REPLACE IN DCB
CHS1     STB,2    UB:US,4           REMEMBER NEW STATE
         MTW,+1   S:EVF             SET EVENT FLAG COUNTER
STNOP    RES      0
ENBISR4  ENABLE
BISR4    RES      0
         B        *11
         PAGE
*        ABORT OR OFF EVENT HANDLER
         SPACE    1
STABRT   CI,15    BAT               CHECK FOR BATCH
         BANZ     SETDL             SET DO LIST
         LI,3     MAXG              CHECK FOR GHOST
         ENABLE                     ALLOW INTERRUPTS   ** ENABLE **
         CB,4     SB:GJOBUN,3       IS HIS USER NUMBER A GHOST
         BE       STABRT1           YES, NO COC LINE
         BDR,3    %-2               CONTINUE
         LI,7     LNOL-1            MUST BE ONLINE, FIND HIS LINE #
         CB,4     LB:UN,7           HIS USER NUMBER
         BE       COCABRT           YES
         BDR,7    %-2               NO, KEEP SEARCHING
         CB,4     LB:UN             MIGHT BE LINE ZERO
         BE       COCABRT           YES
STABRT1  DISABLE                    BLOCK INTERRUPTS   ** DISABLE**
         LB,3     UB:US,4           GET USERS STATE
SETDL    CW,12    =(1**SQR)+(1**SQRO)  CHECK FOR SQR OR SQRO
         BAZ      SETDL1            NEITHER
         LW,1     U:MISC,4          GET RESOURCE
         LB,1     1                 INDEX
         CH,14    SH:RFLG,1         SHOULD WE CHANGE STATE?
         BAZ      SETDL1            NO
         BAL,0    T:UQR             UNQ FROM RESOURCE CHAIN
         OR,6     Y8                SET STATE CHANGE FLAG
SETDL1   RES      0
         CH,14    UH:DL,4           IS THIS FLAG ALREADY SET
         BANZ     ENBISR4           YES, GET OUT
         AH,14    UH:DL,4           MERGE IN NEW FLAG
         STH,14   UH:DL,4           AND PUT AWAY
         BIR,6    STIRC             TEST FLAG FOR STATE CHANGE
         B        ENBISR4           NO STATE CHANGE
         PAGE
*        COMMON PROCESSING FOR E:OFF,E:ERR,E:CBK,E:CEC
*        ONLY E:OFF REQUIRES SPECIAL ADDITIONAL ACTION
         SPACE    1
STBEEAC  OR,6     Y8                SET STATE CHANGE FLAG
STBEEA   OR,6     X1                SELECT RIGHT HALFWORD
         LH,14    X1+(12-E:CBK/2),6 PICK PROPER FLAG
*                                   E:CBK => X1000
*                                   E:CEC => X2000
*                                   E:ERR => X4000
*                                   E:OFF => X8000 (NEGATIVE HALFWORD)
*
         BLZ      STABRT            SPECIAL ABORT PROCESSING
         B        SETDL             SET DOLIST
COCABRT  PUSH     11                SAVE RETURN
         BAL,11   STABRT1           SET FLAGS AND MAYBE CHANGE STATE
         PULL     11                POP RETURN
         B        COCOFF            AND MARK LINE OFF(7=LINE #)
*
*        ASSOCIATE PROCESSOR
*
*        QUEUES USER TO HEAD OF SPECIAL COMPUTE QUEUE
*
STASP    OR,4     Y8                SET HEAD OF Q FLAG
         B        STSC              AND MAKE HIM SPECIAL COMPUTE
STCRD    CI,15    X'4000'           TEST FOR UNBLOCK BEFORE BLOCK
         BANZ     QFORA2            YES
         LI,2     STI               STATE TERMINAL INPUTTING
         B        RCE4              GO CHANGE STATE
STQA     EQU      %
         LH,15    UH:FLG,4
         CI,15    X'4000'
         BAZ      QFORA1
QFORA2   AI,15    -X'4000'          TURN OFF FLAG
         STH,15   UH:FLG,4
         B        T:PULLE
QFORA1   LI,2     SQA
         B        RCE4
STUQA    CI,3     SQA               IS HE QUEUED FOR ACCES
         BE       STSC              YES SPECIAL COMPUTE
STIRCU   RES      0
         OR,15    X4000
         STH,R15  UH:FLG,R4         SAVE NEW FLAGS
         B        ENBISR4           ENABLE AND EXIT
*
*        KICKOUT USER SPECIAL TRANSITION
*
STKOT    LB,2     UB:US,4           FORM NEW STATE
         AI,2     STOBO-STOB        FOR TERMINAL I/O OUT OF CORE
         AND,15   =~(RTR+JIC)       RESET JIC AND RTR
         STH,R15  UH:FLG,R4         SAVE NEW FLAGS
         B        RCE4              AND CHANGE STATE
STKO     AND,15   =~(RTR+JIC)       RESET JIC AND RTR
         STH,15   UH:FLG,4          SAVE FLAGS
         CI,3     SEXU              CHECK FOR EXECUTABLE
         BG       ENBISR4           NO, SKIP STATE CHANGE
         LB,2     UB:PRIO,4         GET PRIORITY
         B        CHSE1             WADE INTO STATE CHANGE
         PCC      0
         PAGE
*  UNQUEUE FOR ALLYCAT... RESIDENT PORTION OF ALLYCAT
         SPACE
STUQFAC  EQU      %
         LI,R1    4                 INDEX FOR BUFFERS
UNQNEXT  AI,R1    -1                DECREMENT INDEX
         BLZ      UNQXIT            EXIT IF NO MORE
         DISABLE
         LH,R2    BUFLAGS,R1        GET FLAGS
         SLS,R2   16                POSITION
         LC       R2                GET MSG
         BCS,4    UNQEMPTY          JUST EMPTIED
         BCS,2    UNQFILL           JUST FILLED
         B        UNQSETFL          DO ARITHMETIC ON EMPTH HGP
UNQEMPTY LH,R2    BOTTOM,R1         UPDATE THE POINTERS
         STH,R2   TEMPBOT,R1
         B        UNQSETFL          RESET THE FLAGS
         SPACE
UNQFILL  LH,R2    TEMPBOT,R1        UPDATE THE POINTERS
         STH,R2   BOTTOM,R1
UNQSETFL LH,R2    BUFLAGS,R1        RESET THE FLAGS
         AND,R2   X9FFF
         STH,R2   BUFLAGS,R1
         SPACE
         LH,R2    WORDCNT,R1        ADJUST WORD COUNT
         AH,R2    ADJSTCNT,R1       TO NEW VALUE
         STH,R2   WORDCNT,R1
         AI,R2    -1                DECREMENT COUNT
         CW,R2    BUFMASK,R1        COMPARE TO MAX POSSIBLE
         BLE      UNQNEXT1          OKAY
         SCREECH  X'88'             BUMMER
UNQNEXT1 LI,R2    0                 NOW ZAP
         STH,R2   ADJSTCNT,R1       ADJUSTED COUNTER
         ENABLE                     LET EM RIP
         SPACE
         B        UNQNEXT
         SPACE
X9FFF    DATA     X'9FFE'
         REF      BOTTOM,TEMPBOT,BUFLAGS
         REF      WORDCNT,ADJSTCNT
         SPACE
UNQXIT   EQU      T:REL1
         TITLE    'RESOURCE BLOCK/UNBLOCK'
*
*        BLOCK AND RELEASE FOR RESOURCES
*
*        SB:RQ CONTAINS THE RESOURCE SUB QUEUE HEADS
*        SB:RQ IS INDEXED BY RESOURCE NUMBER(E:XXX-E:REL)
*
*        ODD NUMBERED RESOURCE EVENT DIFFERENCES MEAN RELEASE
*
T:RES    AI,6     -E:REL            TAKE OFF BASE
         SCS,6    -1                HALVE AND POSITION FLAG
         AI,6     0                 TEST FOR RELEASE
         BLZ      T:REL             YES
         LB,2     SB:RBLK,6         GET BLOCK TRANSFER INDEX
         BNEZ     T:BLKV,2          GO TO IT
         LB,2     SB:RQ,6           GET HEAD OF RESOURCE Q
         STB,6    2                 SAVE RESOURCE INDEX
         STW,2    U:MISC,4          SET FLINK
         LI,2     0                 ZAP
         STB,2    UB:PRIO,4          BLINK
         STB,4    SB:RQ,6           SET NEW HEAD
         LI,2     SQR               NEW STATE
         B        RCE4
*
*
T:REL    LH,2     SH:RFLG,6         GET FLAGS AND INDEX
         CI,2     SPECIFIC          SPECIFIED USER ONLY?
         BANZ     RELB              YES
         CI,2     NULL              CHECK FOR ACTION ON NULL Q
         LB,4     SB:RQ,6           GET HEAD OF SUBQUEUE
         BCR,7    ENBISR4           NONE IN Q AND NO NULL FLAG
RELA     AND,2    M8                SCRUB TO INDEX
         BNE      T:RELV,2          GO TO SPECIAL ROUTINE
T:REL1   DISABLE                    MERGE POIN FOR SPECIAL UNBLOCK ROUTINES
         AI,4     0                 CHECK FOR NULL Q
         BEZ      ENBISR4           YES, GET OUT
         BAL,0    T:UQR             UNQUEUE FOR RESOURCE
         PUSH     11                SAVE RETURN
         LB,3     UB:US,4           GET CURRENT STATE
         BAL,11   STSC              SPECIAL COMPUTE
         PULL     11                RESTORE RETURN
         LH,2     SH:RFLG,6         GET FLAGS
         CI,2     FLUSH             FLUSH ALL>
         BAZ      ENBISR4           NO
         DISABLE                             ***** DISABLE *****
         B        T:REL             CONTINUE FLUSHING
RELB     CW,R12   =(1**SQR)+(1**SQRO)  CHECK THAT HE IS SQR OR SQRO
         BANZ     RELA              YES, OK
         LI,R4    0                 OTHER WISE ZAP USER NO
         B        RELA              TO SKIP UNQ
         PAGE
*
*
*        UNQUEUE FOR RESOURCE
*
*                 CALLED DISABLED
*
*        R0 = LINK
*        R1 = TEMP
*        R4 = USER NUMBER
*        R5 = TEMP
*        R6 = FORCED TO RESOURCE INDEX FOR USER(R4)
*
*        UB:PRIO IS USED AS A BACK LINK
*        BYTE(3) OF U:MISC IS FORWARD LINK
*        BYTE(0) OF U:MISC IS RESOURCE INDEX
*        SB:RQ(R6) CONTAINS HEAD OF SUB-QUEUE
*
T:UQR    LW,5     U:MISC,4          GET FORWARD LINK
         LB,6     5                 RESOURCE INDEX
         LB,1     UB:PRIO,4         GET BLINK
         BNEZ     %+2
         STB,5    SB:RQ,6           SET NEW HEAD
         STB,1    UB:PRIO,5         CROSS LINK REMAINING
         STW,5    U:MISC,1          ENTRIES
         B        *0                RETURN
         PAGE
*
*        SPECIAL ACTION VECTOR FOR RESOURCE BLOCK
*
T:BLKV   EQU      %-1               BASE
*
*
*
*
*
*
*        SPECIAL ACTION VECTOR FOR RESOURCE UNBLOCK
*
T:RELV   EQU      %-1               BASE
UQFAC    B        STUQFAC           UNQUEUE FOR ALLOCAT
OPNUNBLOCK RES    0
         LW,R15   OPNCLSUS          DID ANY GET THERE BEFORE US
         BNEZ     ENBISR4           YES GET OUT
         LH,R15   UH:FLG,R4         GET HIS FLAGS
         OR,R15   X8                SET OPNCLSUSR FLAG
         STH,R15  UH:FLG,R4         AND SAVE NEW FLAGS
         STW,R4   OPNCLSUS          CLEAR, MAKE HIM OPNCLS USER
         B        T:REL1            AND UNBLOCK HIM
*
*
         TITLE    'L O G O N     N E W     U S E R S'
*
*        T:RCE     REPORT COC EVENT
*
*        R11 - LINK
*        R6 - EVENT (MAY BE ALTERED)
*        R7 - LINE # (LINE TABLE INDEX)
*
*        ALL OTHER REGISTERS VOLATILE
*
*        RETURNS ENABLED
*
T:RCE    LB,4     LB:UN,7           USER #
         BEZ      LOGON
         CI,6     E:OFF             SEE IF OFF EVENT FROM COC
         BNE      NOTOFF
         LH,2     UH:FLG2,4         BIT 10 IN UH:FLG2 TO
         OR,2     X20               .INDICATE A REAL
         STH,2    UH:FLG2,4         ..LINE HANGUP
NOTOFF   RES      0
         CI,4     X'FF'
         BNE      RCE0
LOGON    EQU      %
*
*                                   THIS ROUTINE FINDS AN AVAILABLE USE R
*                                   SLOT FOR A GUY WHO IS ATTEMPTING TO  LOG
*                                   ON.  IT THEN GETS A PAGE FOR HIS JI T,
*                                   SETS SOME FLAGS,  AND Q'S HIM UP.
*
         CI,6     E:CBK
         BNE      BISR4
         DISABLE
         LI,1     SNULL             GET HEAD OF
         LB,4     SB:HQ,1           NULL STATE
         BEZ      LOGNO             CAN'T LOGON - NO AVAIL USERS
         LW,1     S:OUIS
         CW,1     S:OUAIS
         BGE      LOGNO
         LI,2     LSWAP+1
         LW,15    S:OUAIS
         CW,15    M:FREE#GRAN-1,2
         BL       %+3
         BDR,2    %-2
         B        LOGNO
         MTW,1    S:OUIS
         STB,4    LB:UN,7
         LW,15    SL:OPRIO          GET DEFAULT ONLINE PRIO
         DEF      ADD1
         TITLE    'ADD A NEW USER'
**************************************************
*                                                *
*          ADD A USER TO THE SYSTEM              *
*                                                *
*                                                *
*        CALLED BY MBS AND T:GJOBSTRT TO         *
*        START BATCH AND GHOST USERS.            *
*        IN-LINE PIECE OF LOGON WHICH STARTS     *
*        ON-LINE USERS.                          *
*                                                *
*        R11 - LINK                              *
*        R4 - USER NUMBER (IN)                   *
*                                                *
*       THE NEW USER WILL BE PLACED IN AN        *
*       EXECUTABLE STATE IF A DISC PAGE IS       *
*       AVAILABLE FOR HIS JIT.  IF NOT, HE       *
*       WILL BE PUT IN SQR AND QUEUED FOR        *
*       A DISC PAGE.  WHEN A DISC PAGE IS        *
*       AVAILABLE AND HE IS SCHEDULED FOR        *
*       INSWAP, THE SWAPPER WILL RE-ENTER        *
*       ADD1 AT GETJIT WHICH WILL AGAIN TRY      *
*       TO GET A SPOT FOR HIS JIT BEFORE HIS     *
*       INITIAL INSWAP.                          *
*                                                *
**************************************************
         SPACE    1
ADD1     EQU      %
         MTW,1    S:CUIS            INCREMENT NO. OF USERS IN SYSTEM
         STB,R15  UB:PRIOB,R4       PUT AWAY USER PRIORITY
*  GET GRAN FOR JIT AFTER DECIDING WHICH RAD AND GRAN POS ON THAT RAD
GETJIT   PUSH     11
         DISABLE
         LI,2     LSWAP+1
         LI,1     LSWAP+1
         LW,15    M:FREE#GRAN-1,1   GET # OF GRAN AVAIL ON 1ST SWAP RAD
GJG1     EQU      %
         CW,15    M:FREE#GRAN-1,1   IS # IN HAND GREATER THAN BUSH
         BGE      GJG2              SURE IS, KEEP IT AND TRY NEXT
         LW,15    M:FREE#GRAN-1,1   NAA, HEAD FOR THE BUSHES
         LW,2     1                 AND POINT TO NEW ONE
GJG2     EQU      %
         BDR,1    GJG1            TRY NEXT
         AI,2     -1
*  2 POINTS TO THE MOST AVAILABLE RAD  GET NXT GRAN POS
         STB,2    UB:SWAPI,4        ALLOCATE USER TO RAD
         LW,1     M:JITPAGE,2       NEXT GRAN POS
         BAL,11   T:SGAJIT
         BCS,1    GJG4              NONE AVAEIL
         LB,1     MB:SPACEJIT,2     INCR VALUE TO SPACE AROUND THIS RAD
         AWM,1    M:JITPAGE,2       UPDATA FOR NXT
         LI,2     STIRC             MAKE HIM INTERACTIVELY EXECUTABLE
GJG3     RES      0
         PULL     11                RESTORE RETURN
         STH,15   UH:AJIT,4         ESTABLISH USERS JIT DISC ADDR.
         LH,R15   UH:FLG,R4         GET USER FLAGS
         OR,R15   =TIC+PPSWP        SET TEL IN CONTROL AND PPSWAP
         STH,R15  UH:FLG,R4         STORE FLAGS
         LI,R3    SQUAN+SWAPD       SET SQUAN AND JUST SWAPPED BIT
         STH,R3   UH:FLG2,R4        IN SECOND FLAGS
         LI,R3    1+:BIG            INITIAL PAGE COUNT
         STB,3    UB:PCT,4          USER NEEDS 1 PAGE FOR HIS JIT
         LB,3     UB:US,4           GET CURRENT STATE
         LI,1     0
         STH,1    UH:DL,4           MAKE SURE DOLIST EMPTY.
         MTB,0    R10               IS THIS A RESOURCCE USER
         BNEZ     RESCNCT           YEP
         B        0,2               DO PROPER STATE CHANGE
GJG4     RES      0
         LI,6     E:ND              RESOURCE INDEX
         LI,2     T:RES             SET TO BLOCK FOR DISC PAGE
         LI,15    -1                SET FLAG FOR SWAPPER
         B        GJG3              MERGE WITH COMMON
LOGNO    EQU      ENBISR4
         PAGE
*
*        T:GJOBSTRT HAS PASSED A RESOURCE INDEX TO BE GIVEN TO THE
*        USER'S M:UC DCB
*
         REF      RAS:DOL,M:UC,SH:RNM
RESCNCT  EQU      %
         LB,R1    R10               RESOURCE NAME INDEX
         STW,R1   RAS:DOL+2         SAVED FOR LATER
         LI,R1    DA(RAS:DOL)       DOLIST ADDRESS
         STH,R1   UH:DL,R4          SAVED FOR EXECUTION SCHEDULING
         B        0,R2              GO TO INTERACT CHANGE
         PAGE
         TITLE    'P U L L   E X I T'
         DEF      T:UTSXTS
T:UTSXTS EQU      %
*                 COPY ENVIRONMENT FROM TSTACK TO USER STACK.
*                 MAPPED.  INTERRUPT INHIBITS UNCHANGED.
*                 R1 = ADDRESS OF USER STACK POINTER DOUBLEWORD.
*                 R0 CONTENTS WILL BE ON TOP OF USER STACK AFTER COPY.
*                 R10/R11 ARE CONTENTS/MASK TO REPLACE PSW0 IN TSTACK
*                         AFTER COPY.
*                 R4 = LINK.  RETURNS 1,R4 IF COPY IS SUCCESSFUL.
*                                   R0,R1,R4,R6 PRESERVED.
*                                   R2 = ADDRESS OF PSW0 IN USERSTACK.
*                                   R3 = MID-ADDRESS OF PSD IN TSTACK.
*                                   R5 = J:TCB.
*                                   R0 IN TSTACK = J:TCB.
*                                   R1 IN TSTACK => PSW0 IN USERSTACK.
*                                   PSW0 IN TSTACK MODIF. PER R10/R11.
*                             RETURNS 0,R4 IF USER STACK IS BAD.
*                                   R0,R1,R4,R6 PRESERVED.
*                                   R10,R11,R14 PRESERVED.
*
         LW,3     1
         BAL,7    CHKPROT-1         CHECK SPD IN 00 SPACE.
         LD,12    *1                12/13 ARE SPD.
         LW,3     12
         AI,3     1
         BAL,7    CHKPROT           CHECK STACK BOTTOM IN 00 SPACE.
         CI,12    1
         BAZ      %+4               IF STACKBOTTOM IS EVEN,
         LI,3     21                  PUSH 21 WORDS
         LI,5     -1                  STARTING WITH A -1.
         B        %+3               IF STACKBOTTOM IS ODD,
         LI,3     20                  PUSH 20 WORDS
         LI,5     0                   STARTING WITH A 0.
         LW,9     L(X'80008000')
         LS,8     13                REMEMBER SPD TRAP BITS.
         OR,13    L(X'80008000')
         MSP,3    12                MODIFY SPD IN 12/13.
         BCS,10   0,4               ----->  EVIL STACK....
         STS,8    13                RESTORE SPD TRAP BITS.
         LW,3     12
         BAL,7    CHKPROT           CHECK STACK TOP IN 00 SPACE.
         STD,12   *1                STORE UPDATED SPD.
         LW,2     12
         AI,2     -18               2 => PLACE FOR PSD.
         LW,3     TSTACK
         AI,3     -17               3 => PSD IN TSTACK.
         LD,14    *3
         STD,14   *2                STORE PSD IN OTHER STACK.
         STS,10   14                  FIX UP PSW0
         STD,14   *3                  IN TSTACK.
         STW,5    -1,2              STORE -1 OR 0 IN OTHER STACK.
         LCI      8
         LM,8     2,3
         STM,8    2,2               STORE REGS 0-7 IN OTHER STACK.
         LM,8     10,3
         LCI      9
         STM,8    10,2              STORE REGS 8-15 IN OTHER STACK.
         LW,5     J:TCB
         STW,5    2,3               STORE TCBADDR IN R0 IN TSTACK.
         STW,2    3,3               STORE => PSD  IN R1 IN TSTACK.
         B        1,4               -----> OKAY RETURN...
*
*
         DEF      CHKPROT
         LI,15    -1                GARBAGE PAGE # FOR FIRST CALL.
CHKPROT  EQU      %
*                 CHECK STOREABILITY IN *R3. USES R2,R3,R15.
*                 RETURN 0,R7 IF OKAY,  0,R4 IF BAD.
         REF      X1FE00
         AND,3    X1FE00            CONVERT ARG TO PAGE ADDRESS.
         CW,3     15                SAME PAGE...
         BE       0,7               ---> YES. MUST STILL BE OKAY.
         REF      JOVVPA
         CI,3     JOVVPA            OUTSIDE THE MONITOR ROOT...
         BGE      %+2               ---> YES.
         B        0,4               ---> NO. MUST BE BAD.
         LW,15    3                 REMEMBER PAGE ADDRESS.
         SLD,2    21                R2= PAGE#/4.
         SCS,3    2                 R3= PAGE# MOD 4.
         REF      J:JAC
         LB,2     J:JAC,2           GET BYTE OF ACCESS CODES.
         CB,2     L(X'C0300C03'),3  COMPARE THE PROPER TWO BITS.
         BAZ      0,7               ---> STOREABLE. RETURN OKAY.
         B        0,4               ---> NOT STOREABLE. RETURN BAD.
         PAGE
         DEF      T:PULLE
T:PULLE  EQU      %
         DISABLE
         BUMP     -19,2
         BCR,1    T:PULLE1          B/STACK NOT EMPTY
         LW,2     J:JIT             L/WD 0 OF JIT
         BEZ      T:PULLE1          BEZ; MONITOR JIT, DON'T TOUCH TSTACK SIZE
         LI,2     JTSTACKSZ         L/USER JIT'S TSTACK SIZE
         STH,2    TSTACK+1          PURGE OSTACK; RESET SPACE COUNT
T:PULLE1 EQU      %
GRANT    EQU      T:PULLE
         LI,2     2
         AW,2     TSTACK
         STW,2    PULLE1+1
         LCI      0
         LM,0     2,2
         LPSD,8   *PULLE1+1
         PAGE
*
*        CLOCK4 INTERRUPT ROUTINE
*
         REF      CLK4PSD
         DEF      CLK4
CLK4     EQU      %
         PUSH     9
         LW,9     CLK4PSD
         CW,9     Y008
         BAZ      CK3EX
         PULL     9
         LPSD,11  C3MP              CLEAR INT,PUSHE AND SSE1
CK3UM1   T:PUSHE  CLK4PSD
         B        SSE1
CK3EX    PULL     9
         LPSD,11  CLK4PSD           CLEAR INT AND RETURN
         TITLE    'S W A P     S C H E D U L E R'
         SPACE    2
*************************************
*        SWAP SCHEDULER             *
*************************************
         SPACE    2
         DEF      TSS1
T:SS     EQU      %
         LI,0     1
         XW,0     S:SIP             SWAPPER BUSY?
         BNE      BISR4             YUP AND NOT RE-ENTRANT
         STW,0    DID%IO
TSS1     EQU      %
         PUSH     11
TSS2     EQU      %
         LD,14    DOUBLEZERO        GET MORE ZEROES
         LCI      3                 SET TO STORE 3 WORDS
         STM,14   S:PCT             CLEAR S:PCT,S:FPPH,S:FPPT
         STM,14   S:FPPC            CLEAR S:FPPC,S:AJP,SB:OSN
         STM,R14  S:OSS             ZAP COUNT OF PROCESSORS
*
* PICK A USER TO SWAP IN.
*
         LI,15    RTR
         LD,2     SB:HQ             GET PRESENCE INDICATORS FOR FIRST 7
         BEZ      PIKF1             NONE, SKIP FIRST SEVEN
         OR,2     Y7D               SET EXPONENT FOR FLOATING SHIFT
         SFL,2    16                DO NORMALIZE TO FIND FIRST FULL STATE
         SCS,2    7                 COUNT=COUNT/2
         AND,2    M6                SCRUB
         EOR,2    M6                INVERT TO FORM INDEX
         B        %+2
PIKF1    LI,2     8                 START WITH EIGHTH STATE
PIKUS1   LB,4     SB:HQ,2           PICK UP QUEUE HEAD
         BEZ      PIKUS3
PIKUS2   CH,15    UH:FLG,4
         BAZ      SSIN              GOT ONE WHO NEEDS TO COME IN
PIKUS25  RES      0
         LB,4     UB:FL,4           MOVE TO NEXT IN Q
         BNEZ     PIKUS2
PIKUS3   EQU      %
         AI,2     1                 NEXT STATE
         CI,2     SEXU              MUST BE EXECUTABLE
         BLE      PIKUS1            IT IS, GET HEAD AND LOOK
NO1IN    LI,14    0
         STW,14   S:ISUN
         B        USERSOUT
*
PIKUS5   LI,0     0                 ZERO ZERO
         LI,R15   RTR               RESTORE READY TO RUN BIT
         B        PIKUS25           TRY ANOTHER
         PAGE
*  AT THIS POINT WE KNOW WHO WE WANT TO BRING IN.
*  REGISTERS ARE:
*     0 = 0
*     4 = USER #
*     3 = Q HE IS IN.
*
*  OTHER RESISTERS USED CONSISTANTLY ARE:
*     1 = UB:APR         ASSOCIATED PROCESSOR ROOT
*     2 = UB:APR         ASSOCIATED PROCESSOR OVRLAY SEG.
*   15 = PAGES NEEDED
*    14 = UH:FLG,4
*
*
SSIN     CW,R4    S:ISUNF           DID WE FAIL ON THIS GUY?
         BNE      SSIN12             NO
         LW,R7    S:SEVF            HAS SWAP SET CHANGE
         CW,R7    S:FSEVF           OCCURRED SINCE WE FAILED?
         BNE      SSIN12            YES GO ON
         LW,R7    ALLOOUT           DOES ALLYCAT NEED TO GO OUT?
         BEZ      PROUT3            NO
         B        NO1IN             YES
SSIN12   RES      0
         MTH,0    UH:FLG,4          CHECK FOR BYPASS FLAG
         BGE      SSIN1             NO
         BAL,R7   T:TOTESZ          FIND HIS REAL SIZE
         BAL,R6   GIVEUP7           TRIGGER PAGE STEALER RETURN
         B        PIKUS5            STILL WONT FIT
         LH,R7    UH:FLG,R4         GET FLAGS
         AI,R7    -BYPASS           RESET BYPASS BIT
         STH,R7   UH:FLG,R4         PUT AWAY UPDATED FLAGS
         LI,0     0                 ZERO ZERO
SSIN1    RES      0
         STW,4    S:ISUN            SAVE USERS #
         LB,14    UB:PCT,4          PICK UP # OF PAGES USER NEEDS
         STB,0    SB:NP
         LB,6     UB:OV,4
         BAL,1    PRCAV+1
         LH,15    UH:FLG,4
         CI,15    JIC               SEE IF THE GUYS PARTIALLY IN CORE
         BAZ      CHKDELTEL            NOPE'
         LOAD,6   UX:JIT,4          SUBTRACT THE PAGES HE HAS
         SLS,6    11                 FROM OUR REQUIREMENT
         AI,6     JBPPC
         LB,7     0,6
         SW,14    7
         CI,15    TIC               IS TEL IN CONTROL
         BANZ     CHKDT4             YES GET TEL
         B        PROCAVL           NO GET OTHER PROCS
         PAGE
*
*  CHECK TO SEE IF DEL OR TEL NEED TO BE
*  ASSOCIATED OR DE-ASSOCIATED
*
CHKDELTEL   EQU   %
         CI,15    TIC               IS TEL IN CONTROL
         BAZ      CHKDT3
         BAL,2    ITEL              INC TEL
         BAL,2    IOV
CHKDT4   EQU      %
         LB,6     UB:ACP,4          GET COMMAND PROC #
         B        PRCAVM1
CHKDT3   BAL,2    IPROCS            COUNT UP PROCS
         BAL,2    IOV
         PAGE
*
*  NOW MAKE SURE THE NECESSARY PROCESSORS ARE AVAILABLE
*
PROCAVL  EQU      %
         CI,15    DIC
         BANZ     %+3
         LB,6     UB:ASP,4
         BNEZ     %+2
         LB,6     UB:DB,4
         BAL,1    PRCAV+1
         LB,6     UB:APR,4          MAKE PROC ROOT AVAIL
         BAL,1    PRCAV+1
         LB,6     UB:APO,4          MAKE PROC OVERLAY AVAIL
PRCAVM1  LI,1     SWIPEPGS
PRCAV    EQU      %
         AI,6     0
         BEZ      PRCAV1
*
         DO1      PERFORM
         DO       PFRQ
         MTH,+1   PH:FRQ,R6         BUMP REQUEST COUNT
         FIN      PFRQ
*
         LOAD,8   PX:HPP,6
         BNEZ     PRCAV1
*
         DO1      PERFORM
         MTW,1    C:NOPROC          COUNT UP # TIMES NOT AVAIL
*                                                                       01745000
         MTB,1    SB:NP
         LB,7     PB:PSZ,6
         AW,14    7
         LB,7     SB:NP             PUT PROC  INTO INSWAP LIST
         STB,6    SB:PNL,7
PRCAV1   RES      0
         B        0,1
         PAGE
SWIPEPGS EQU      %
*
*  NOW WE KNOW EXACTLY HOW MANY PAGES WE NEED.
*  FIRST WE'LL GET THE FREE ONES, THEN TRY TO SWIPE
*  SOME FROM UNUSED PROCESSORS
*
         STW,14   S:PCT
         AI,14    0
         BE       GOTEXAC
         DISABLE
         LCI      3                 PICK UP ALL FREE PAGES
         LM,1     DOUBLEZERO           (ASSUMES M AND S:FPPH,T,C IN
         LM,5     M:FPPH                SEQUENCE)
         STM,0    M:FPPH
         STM,5    S:FPPH
         ENABLE
         LI,3     PPROCS
         SW,R14   S:FPPC            CHECK FOR FIT WITH FREE PAGES
         BLZ      GOTNUF            YES
         BEZ      SWAPIN            EXACTLY EVEN
*        B        PFA               FALL THROUGH TO PFA
         PAGE
*
*        ACCUMULATE A LIST OF ALL FREE, IN-CORE SHARED PROCESSORS
*
*        THE SHARED PROCESSOR TABLE, PX:HPP, WILL BE SCANNED A
*        DOUBLEWORD AT A TIME TO QUICKLY SKIP OVER THE MAJORITY
*        CASE OF PROCESSEORS WHICH ARE NOT IN CORE.  A NON-ZERO
*        DOUBLEWORD LOOK WILL TRIGGER A DETAIL SCAN OF THAT AREA.
*        THOSE IN-CORE PROCESSORS WITH ZERO USE COUNT(PB:UC) WILL
*        BE ADDED TO THE LIST OF ACQUIRABLE PROCESSORS(S:FPL) BY
*        GETPRCPG AND THE TOTAL PAGES WHICH MAY BE ACQUIRED FROM
*        UNUSED SHARED PROCESSORS ACCUMULATED IN S:PRPC.
*        NO PROCESSORS WILL ACTUALLY BE KICKED OUT UNTIL IT
*        HAS BEEN DETERMINED THAT A SUCCESSFUL SWAP MAY BE
*        SCHEDULED.
*
PFA      RES      0
         CI,R3    7-:BIG-:BIG-:BIG-:BIG   :BIG=1 FOR SIGMA9; 0=SIGMA6
         BANZ     PF3A              STAY IN SLO LOOP
         SLS,R3   :BIG-3            ALIGN  FOR FAST LOOP SCAN
PF2A     AI,3     -1                NEXT GROUP
         BGEZ     PF1               THERE IS 1
         B        PF3B              THAT'S ALL, SEE IF SUFFICIENT
PF1      LD,6     PX:HPP,3          4 OR 8 ENTITIES
         BEZ      PF2A              NONE ARE IN
         SLS,R3   3-:BIG            ALIGN FOR SLO LOOP
         AI,R3    7-:BIG-:BIG-:BIG-:BIG
PF3      LOAD,8   PX:HPP,3          IS IT IN CORE
         BEZ      PFA               NOT THIS ONE
         LB,2     PB:UC,3           HOW MANY USERS?
         BNEZ     PFA               AT LEAST 1
         DO       0
         SCS,3    -5
         LW,8     PBT:LOCK,3
         SLD,2    5
         SLS,8    0,2
         AW,3     2
         BL       PFA               IT'S LOCKED IN
         FIN
         BAL,6    GETPRCPG          LINK IT'S PAGES TO S:FPPH
PF3A     BDR,R3   PF3               NEXT PROCESSOR
PF3B     SW,R14   S:PRPC            SUBTRACT PROCESSOR TOTAL PAGES
         BGZ      USERSOUT          NOT ENOUGH, TRY FOR USERS TOO
GOTNUF   RES      0
         MTW,+1   S:SEVF            BUMP SWAP SET CHANGE COUNTER
         LW,R14   S:ISUN            ANY BODY COMING IN?
         BEZ      SWAPOUT           NO, THEN WE HAVE NO PAGES
         LW,R14   S:PCT             GET PAGE COUNT REQUIRED
         SW,R14   S:OSS             SUBTRACT USER PAGES
         SW,R14   S:FPPC            AND FREE PAGES
         BLZ      RETXCS            RETURN EXCESS IF ANY
         BEZ      DOSWAP            EXACTLY, DOSWAP
         LW,R3    S:FPL             GET COUNT OF PROCSIN LIST
         CI,R3    1                 SKIP SORT IF ONLY ONE
         BLE      KOPROC            YES
SORTL    LI,R8    0                 CLEAR SWITCH FLAG
         LW,R3    S:FPL             GET COUNT
         AI,R3    -1                CORRECT INDEX
SL1      LW,R9    S:FPL,R3          GET AN ELEMENT
         CW,R9    S:FPL+1,R3        CHECK ORDER
         BGE      SL2               OK SKIP SWITCH
         XW,R9    S:FPL+1,R3        XCHANGE
         STW,R9   S:FPL,R3           THEM
         LI,R8    4                 AND SET FLAG TO SAY WE DID
SL2      BDR,R3   SL1               CONTINUE SCAN
         BDR,R8   SORTL             ANOTHER PASS IF ANY SWITCHES
KOPROC   RES      0
*        KICKOUT NECESSARY FREE PROCESSORS
*
         LW,R1    S:FPL             GET COUNT IN LIST
KOPRL    LI,R3    X'FF'             MASK FOR PROCESSOR NUMBER
         AND,R3   S:FPL,R1          GET LOWEST FREQ PROCESSOR
         LOAD,R8  PX:HPP,R3         GET HEAD OF ITS PAGE CHAIN
         LOAD,R7  PX:TPP,R3         GET TAIL OF PROCS CHAIN
         XW,R7    S:FPPT            SWAP WITH SWAPPER CHAIN TAIL
         BNEZ     %+3               GOT SOME ALREADY
         STW,R8   S:FPPH            ELSE ESTABLISH HEAD
         B        %+2
         STORE,R8 MX:PPUT,R7        OTHERWISE CHAIN TO TAIL OF SWAPPER CHAIN
         LB,R7    PB:PSZ,R3         ADD SIZE
         STORE,R0 PX:HPP,R3           (ZAP CHAIN HEAD)
         AWM,R7   S:FPPC            TO PAGE COUNT
         AI,R1    -1                NEXT PROCESSOR
         SW,R14   R7                AND SUBTRACT FROM REQUIREMENT
         BGZ      KOPRL             STILL NEED MORE
         BEZ      DOSWAP            EXACTLY
RETXCS   LW,R5    S:FPPH            GET HEAD OF CHAIN
         DISABLE
         LCW,R6   R14               GET POSITIVE NUMBER TO RETURN
         CW,R6    S:FPPC            AND COMPARE WITH CURRENT FREE POOL
         BLE      RETOK             ALL OK, NOT MORE THAN ARE THERE
         LCW,R14  S:FPPC            TOO MANY, DEFAULT TO ALL
         BEZ      RETXCS1           NONE TO RETURN
         LW,R6    S:FPPC            POSITIVE RETURN COUNT
RETOK    AWM,R14  S:FPPC            DECREMENT SWAPPER PAGE COUNT
         BNE      %+2               SOME LEFT
         STW,R0   S:FPPT            RETURNING ALL, ZAP TAIL
         AWM,R6   M:FPPC            ADD COUNT TO FREE PAGE POOL
         LW,6     M:FPPT
         BNEZ     %+3               DOES FREE PAGE CHAIN EXIST?
         STW,5    M:FPPH            NO, ESTABLISH HEAD
         B        %+4
         STORE,5  MX:PPUT,6         YES, LINK TO TAIL
         B        %+2
         LOAD,5   MX:PPUT,5         FIRST BIR,14 FOR CASE OF 1 PAGE
         BIR,14   %-1
         STW,5    M:FPPT            UPDATE TAIL
         LOAD,6   MX:PPUT,5
         STORE,0  MX:PPUT,5         ZERO TAIL OF CHAIN
         STW,6    S:FPPH            UPDATE SWAPPER HEAD
RETXCS1  RES      0
         ENABLE
DOSWAP   LI,R1    SWAPIN            ASSUME BEST CASE
         LB,R14   SB:OSN            ANY TO OUTSWAP?
         BEZ      %+2               NO
         LI,R1    SWAPOUT           YES
PGCHKM   RES      0
         LI,7     M:FPPH
T:PGCHK  RD,0     0
         BCR,1    0,1
         DISABLE
         STW,2    J:BASE
         LI,0     -1024       MAX POSSIBLE CHAIN LENGTH
         LW,2     0,7
         BEZ      PPR2
PPR3     BIR,0    %+2
         B        PGSCR             LOOP
         LOAD,11  MX:PPUT,2
         BEZ      PPR2
         LOAD,2   MX:PPUT,2
         AI,11    -NPMC
         BNE      PPR3
PGSCR    SCREECH  X'01'
         PAGE
*S*********************************************************************
*S*                                                                   *
*S*      SCREECH CODE: 01           CALLED FROM SCHED AND SWAPPER     *
*S*      MESSAGE: PAGE CHAIN INCONSISTENCY                            *
*S*      SIGNIFICANT REGISTERS:                                       *
*S*               R0 - NEGATIVE COUNT OF MAX CHAIN LENGTH REMAINING   *
*S*               R1 - RETURN ADDRESS FOR T:PGCHK                     *
*S*               R2 - CURRENT PAGE NUMBER IN CHAIN                   *
*S*               R7 - ADDRESS OF CHAIN BEING CHECKED(S:FPPH,M:FPPH)  *
*S*              R11 - TEMP FOR CURRENT PAGE BEING CHECKED            *
*S*      REMARKS: THIS CHECK IS ONLY PERFORMED IS SENSE SWITCH        *
*S*               FOUR IS SET AS IT COSTS MUCH CPU TIME.  SINCE       *
*S*               THERE ARE MANY REASONS FOR DECLARING A PAGE         *
*S*               CHAIN INCONSISTENT OR DEFECTIVE, AN INSPECTION      *
*S*               OF THE APPROPRIATE CHAIN WILL BE NECESSARY TO       *
*S*               ASCERTAIN THE DEFECT PRESENT.                       *
*S*               T:PGCHK WILL REJECT A CHAIN IF:                     *
*S*               A.) LINKING FROM HEAD FOR COUNT PAGES DOES NOT      *
*S*                   YIELD TAIL.                                     *
*S*               B.) ANY PAGE IS LESS THAN NPMC (NO PAGE MAP CONST)  *
*S*               C.) THE CHAIN LENGTH EXCEEDS MAXIMUM INDICATING     *
*S*                   A CIRCULAR CHAIN.                               *
*S*********************************************************************
PPR2     CW,2     1,7
         BNE      PGSCR
         AI,0     1024
         CW,0     2,7
         BNE      PGSCR
         LW,2     J:BASE            RESTORE R2
         REF      J:BASE
         ENABLE
         B        0,1
GOTEXAC  EQU      SWAPIN
         PAGE
USEROR   BAL,R5   GIVEUP3           GIVEUP AND RETRY
USERSOUT EQU      %
*
*  WE HAVE TO CHOOSE SOME ONE TO GO OUT.
*  WE'LL TRY FOR JUST 1 USER, BUT ALSO FORM A LIST OF
*  A SET TO SWAP OUT IF NECESSARY
*
*
         LW,R7    Y8                SET USEROUT IN PROG FLAG
         STS,R7   S:ISUNF           BIT 0 OF S:SIP
         LW,R13   S:EVF             GET EVENT FLAG COUNTER
         LI,11    0
         LI,7     0
         STB,7    SB:FPN            # FREED
         STB,7    SB:OSN
         STW,7    S:OSS             PGS ACQRD FRM USERS
         LI,9     0                 TOTAL PAGES ACCUMULATED
         LI,15    JIC+RTR
USOUT4   AI,7     1
         LB,3     SB:SWP,7
         CI,3     SEXU              ARE WE AT QUEUES WORTH KEEPING
         BG       USOUT2            NOT YET
         LW,11    S:ISUN            MEAKE 11 NON-ZERO
         BEZ      PROUT3            NO ISUN HAVE ALL OUTSWAP PEOPLE
         AI,3     0                 TEST FOR END
         BE       GIVEUP
*
USOUT2   LB,4     SB:TQ,3           SEARCH Q'S BACKWARD
         BEZ      USOUT4
         CW,R4    S:ISUN            IS HE THE GUY WE ARE BRINGING IN
         BE       GIVEUP
         CH,15    UH:FLG,4
         BANZ     USOUT5
USOUT7   LB,4     UB:BL,4
         B        USOUT2+1
USOUT5   EQU      %                 DON'T SWAP THE ONLY USER WILL
*                                   WILL SCHEDULE
         LH,6     UH:FLG2,4
         CI,6     RTHOLD+CALINT     REAL TIME LOCK IN CORE OR CAL INTERRUPT
         LB,5     UB:MF,4           DOES HE HAVE I/O GOING
         BCS,7    USOUT7            YES, LOCKED OR I/O GOING
         LB,2     UB:US,4
         CI,2     SEXU              IS HE EXECUTABLE
         BG       USOUT9            NO
         LH,5     UH:FLG,4
         CI,5     RTR
         BAZ      USOUT9            NOPE
         CI,6     RMAHOLD+SQUAN     RMA LOCK OR NOT HAD SWAP QUAN
         BANZ     USOUT7            YUP...PASS HIM BY
         REF,1    JIT
         CI,5     BAT               IS HE BATCH
         BAZ      USOUT9            NO, OK TO SWAP HIM
         LOAD,5   UX:JIT,4          GET HIS JIT
         SLS,5    11                MAKE IT A BYTE ADDRESS
         AI,5     BA(JB:PNR)-BA(JIT)
         LB,5     0,5               GET PARTITION NUMBER
         LH,5     PLH:FLG,5         CHECK FOR HOLD
         BLZ      USOUT7            HE IS HELD. DONT SWAP HIM
         REF      PLH:FLG
USOUT9   EQU      %
         LB,6     SB:OSUL           DONT EXCEED TABLE
         CI,6     SMAXOUT-1         SIZE
         BGE      USOUT7
         LOAD,6   UX:JIT,4          PHYS JIT ADR TO FIND
         SLS,6    11                 HOW MANY PAGES HE HAS
         AI,6     JBPPC
         LB,8     0,6               USER PAGE COUNT
         AW,9     8                 ADD TO TOTAL PAGES ACCUM.
         AWM,R8   S:OSS             ACCUMULATE TOTAL OF USER PAGES
         MTB,1    SB:OSN
         LB,2     SB:OSN
         STB,4    SB:OSUL,2         ADD HIM TO THE OUS SWAP LIST
         LI,2     ADDPRC            NOW LETS GET ANY PROCESSORS
         BAL,3    DOV               THAT COME FREE BECOUSE
         LI,3     USOUT10           THIS GUY IS GETTING SWAPPED
         LH,15    UH:FLG,4
         CI,15    TIC
         BANZ     DTEL
         LI,3     %+4
         CI,15    DIC
         BANZ     DDB
         B        DASP
         LB,1     UB:APR,4
         BAL,3    CHKPRC
         LB,1     UB:APO,4
         BAL,3    CHKPRC
USOUT10  EQU      %
         LI,15    JIC+RTR
         LW,6     S:ISUN
         BEZ      USOUT7
         CW,9     14
         BL       USOUT7            NOT ENOUGH PAGES YET
         B        PROUT2
CHKPRC   EQU      %
         MTB,-1   PB:UC,1           COUNT IT DOWN
ADDPRC   BNEZ     0,3               NOT 0 YET
         CW,9     14
         BGE      0,3
         LOAD,6   PX:HPP,1
         BEZ      0,3               NOT IN CORE
         LB,6     PB:PSZ,1          # PAGE
         BEZ      0,3               NONE
         AW,9     6                 TOTAL PAGES ACCUM.
         MTB,1    SB:FPN            ADD TO FREE PROC LIST
         LB,6     SB:FPN
         STB,1    SB:FPN,6
         B        0,3
         PAGE
*
*  DECREMENT ANY ASSOCIATED PROCESSORS FOR USER LIST
*  IF WE HAVE ENOUGH PAGE SWAP THE LIST.
*  IF NOT, SEE IF THE USERS WE CHOSE MADE ANY PROCESSORS FREE
*  IF SO, TAKE THEIR PAGES
*  IF NOT GIVE UP. WE CANT FIND A SWAP SET
*
PROUT2   EQU      %
         CW,R13   S:EVF             TEST FOR ANY EVENTS
         BNE      USEROR            YES
         LB,5     SB:FPN
         BEZ      PROUT3
         LB,3     SB:FPL,5
         BAL,6    GETPRCPG          GET THEIR PAGES
         BDR,5    %-2
PROUT3   EQU      %
         LB,7     SB:OSN
         BEZ      SSEXIT
         LI,11    PROUT5
PROUT4   RES      0
         LI,6     E:KO
         LB,5     SB:OSUL,7         KICK THE USERS OUT
T:RUE    LW,4     5
         B        RCE0
PROUT5   BDR,7    PROUT4
         STB,R7   S:ISUNF           CLEAR USEROUT FLAG
*                                   (R7 CONTAINS ZERO FROM BDR)
         B        GOTNUF            GO TO RETURN EXCESS AND PERFORM SWAP
GIVEUP   EQU      %
         MTW,1    C:NSP             COUNT NO SWAP BY ANY MEANS
         LCI      3                 CANT SWAP =
         LM,5     S:FPPH
         AI,6     0
         BEZ      GIVEUP6
         DISABLE
         LW,4     M:FPPT            ANY IN CHAIN?
         BEZ      GIVEUP5           NO
         STORE,5  MX:PPUT,4         HEAD->TAIL
         STW,6    M:FPPT            TAIL -> TAIL
         AWM,7    M:FPPC            COUNT -> COUNT
         B        GIVEUP6
GIVEUP5  EQU      %
         LCI      3
         STM,5    M:FPPH            ALL BACK AT ONCE
GIVEUP6  EQU      %
         ENABLE
         LI,5     GIVEUP4
GIVEUP3  EQU      %
         LB,7     SB:OSN
         BEZ      0,5
         LB,4     SB:OSUL,7         INCREMENT THEIR PROCESSORS SINCE
         BAL,2    ITORP
         BAL,2    IOV
         BDR,7    %-3
         B        0,5
GIVEUP4  EQU      %
         LW,4     S:ISUN
         STW,R4   S:ISUNF           SAVE FAILING USER
         LW,R15   S:SEVF            AND SWAP SET COUNTER
         STW,R15  S:FSEVF           TO DEFINE FAILURE
         LH,15    UH:FLG,4
         CI,15    JIC
         BANZ     GIVEUP1
         BAL,2    DOV
         BAL,R2   DTORP             DECREMENT TEL OR PROCESSORS
GIVEUP1  EQU      %
         BAL,7    T:TOTESZ
         DISABLE
         LW,7     S:PCORE
         AI,R7    6                 ADD OVERLAY SIZE BACK IN
         CW,0     7                 WILL HE EVER FIT
         BLE      GIVEUP8           YES
         SCREECH  X'62'             NO-IMPOSSIBLE SWAP
         LI,R6    GIVEUPA           SET RETURN
GIVEUP7  BAL,R7   T:TOTESZ
         AI,R2    6                 ACCOUNT FOR MON OVERLAY
         CW,R2    S:PCORE           CHECK FOR FIT EVER
         BLE      GIVEUP8           YES
         SCREECH  X'62'             NO- IMPOSSIBLE SWAP
*S*********************************************************************
*S*                                                                   *
*S*      SCREECH CODE: 62           CALLED FROM SCHED                 *
*S*      MESSAGE: IMPOSSIBLE SWAP CONDITION                           *
*S*      SIGNIFICANT REGISTERS:                                       *
*S*               R0 = USER SIZE IN PAGES LESS LOCKED PROCESSORS      *
*S*               R2 = GROSS USER SIZE IN PAGES                       *
*S*               R4 = USER NUMBER                                    *
*S*               R6 = RETURN ADDRESS FOR GIVEUP7                     *
*S*              R15 = USER FLAGS (UH:FLG)                            *
*S*      REMARKS: THE USER CHOSEN TO INSWAP WILL NEVER FIT INTO       *
*S*               AVAILABLE PHYSICAL MEMORY.  THIS MAY BE DUE TO      *
*S*               EITHER AN OPERATING SYSTEM SOFTWARE PROBLEM OR     *
*S*               ABORTING WITHOUT FIRST RELEASING LOCK.             *
*S*********************************************************************
GIVEUP8  RES      0
         LW,R7    S:ACORE           GET AVAIL FLUID PAGES
         SW,R7    S:RTCORE          SUBTRACT RTHOLD PAGES
         LW,R5    S:STL#            NUMBER OF STOLEN PAGES
         SW,R5    SL:RSVP           RESERVED PAGES
         BGEZ     %+2               ALL ARE RESERVED
         LI,R5    0                 SET RESERVED CONTRIBUTION TO ZERO
         SW,R0    R7                FIND REQUIREMENT DEFICIT
         BLEZ     1,R6              HE FITS, RETURN SKIPPING
         CW,R0    R5                CAN IT BE SATISFIED BY STOLEN
         BG       GIVEUP9           NO, JUST SET BYPASS FLAG
         LCW,0    0                 INVERT
         CW,0     S:STLC            REMEMBER MOST NEGATIVE
         BGE      %+2
         STW,0    S:STLC
GIVEUP9  RES      0
         ENABLE
         B        0,R6              NORMAL RETURN
GIVEUPB  RES      0
         LH,7     UH:FLG,4          GET FLAGS
         OR,7     X8000             SET BYPASS BIT
         STH,7    UH:FLG,4          PUT AWAY
GIVEUPA  B        GIVEUPB
SSEXIT   LI,0     0
         STB,R0   S:ISUNF           CLEAR USEROUT FLAG
         STW,0    S:SIP             RESET THE SWAP-IN-PROGRESS FLAG
         B        T:SEXIT
         TITLE    'S U B R O U T I N E S'
*
*        SUM TOTAL USER SIZE
*
*        R0 - TOTAL USER SIZE (OUTPUT) LESS LOCKED PROCS
*        R1 - TEMP            (VOL)
*        R2 - TOTAL USER SIZE (OUTPUT) INCLUSIVE
*        R3 - TEMP            (VOL)
*        R4 - USER NUMBER     (INPUT)
*        R5 - TEMP            (VOL)
*        R7 - LINK
*        R15 - TEMP - FLAGS   (VOL)
*
T:TOTESZ EQU      %
         LH,15    UH:FLG,4          GET USER FLAGS
         LB,0     UB:PCT,4          DATA PAGE COUNT
         LB,R2    UB:PCT,R4         AND AGAIN
         CI,15    TIC               CHECK FOR TEL
         BANZ     TOTE1             YES
         CI,15    DIC               CHECK FOR DELTA
         BANZ     TOTE2             YES
         LB,1     UB:APR,4          PROCESSOR ROOT
         BAL,5    TOTE              ADD PSZ
         LB,1     UB:APO,4          PROCESSOR OVERLAY
         BAL,5    TOTE              ADD ITS PAGES
         LB,1     UB:ASP,4          GET SPECIAL SHARED PROC
         BEZ      TOTE2             ---> (OR DEBUGGER IF NO ASP)
TOTE3    BAL,5    TOTE              ADD
         LB,1     UB:OV,4           MONITOR OVERLAY
         BAL,5    TOTE              ADD
         B        0,7               RETURN
TOTE1    LB,1     UB:ACP,4          COMMAND PROCESSOR
         B        TOTE3
TOTE2    LB,1     UB:DB,4           DEBUGGER
         B        TOTE3
TOTE     BEZ      0,5               RETURN IF NO
         LB,R3    PB:PSZ,R1         GET PROCEDURE SIZE
         AW,R2    R3                ADD TO INCLUSIVE TOTAL
         MTB,0    PB:LCT,R1         TEST FOR LOCK
         BNEZ     0,R5              YES, DONT ADD TO NET TOTAL
         AW,R0    R3                ADD SIZE TO NET TOTAL
         B        0,5               RETURN
         PAGE
*
* MISC ROUTINES
*
*
*  INCREMENT ASSOCIATED PROCESSOR COUNTS  (DECREMENT)
*  BAL ON 2, USER IS 4
*
*
         DEF      IPROCS,DRTEL1,ISTEL1
         DEF      DASP
         DEF      IDB
         DEF      DTEL
         DEF      DPROCS
DRTEL1   RSETST   TIC               DECR/RESET TEL
DTEL     EQU      %
         LB,1     UB:ACP,4          GET COMMAND PROC #
DECR     MTB,-1   PB:UC,1
         B        0,2
ISTEL    LSETRST  TIC               INCR/SET TEL
ISTEL1   EQU      ISTEL+1           ENTRY IF GLAGS IN 15
ITEL     EQU      %
         LB,1     UB:ACP,4          GET COMMAND PROC #
INCR     MTB,1    PB:UC,1
         B        0,2
DTORP    CI,R15   TIC               CHECK FOR TEL IN CONTROL
         BANZ     DTEL              YES
DPROCS   LB,1     UB:APR,4
         MTB,-1   PB:UC,1
         LB,1     UB:APO,4
         MTB,-1   PB:UC,1
         LH,15    UH:FLG,4
         CI,15    DIC
         BANZ     DDB
DASP     LB,1     UB:ASP,4          DECR ASP
         BNEZ     DECR
DDB      LB,1     UB:DB,4
         B        DECR
DOV      LB,1     UB:OV,4
         B        DECR
ITORP    LH,15    UH:FLG,4
         CI,15    TIC
          BANZ    ITEL
IPROCS   LB,1     UB:APR,4          INCCR PROCS
         MTB,1    PB:UC,1
         LB,1     UB:APO,4
         MTB,1    PB:UC,1
         LH,15    UH:FLG,4
         CI,15    DIC
         BANZ     IDB
         LB,1     UB:ASP,4          INC ASP
         BNEZ     INCR
IDB      LB,1     UB:DB,4
         B        INCR
IOV      LB,1     UB:OV,4
         B        INCR
         PAGE
GETPRCPG EQU      %
*
*        ADD PROCESSOR PAGES TO CURRENT TOTAL AND PLACE PROCESSOR
*        IN LIST OF PROCESSORS TO BE FREED.
*
*        INPUT :  R3 - PROCESSOR NUMBER
*        OUTPUT:  S:FPL = S:FPL+1
*                 S:FPL(S:FPL(0)) = PH:FRQ(R3),0,R3
*                 S:PRPC = S:PRPC+PB:PSZ(R3)
*        SCRATCH: R7,R8,BITS 0-23 OF R3
*        CALL:    BAL,R6 GETPRCPG
*                 NORMAL RETURN ONLY
*
*
         MTW,+1   S:FPL             BUMP COUNT OF PROCS IN LIST
         LW,R7    S:FPL             GET COUNT
         DO       PFRQ
         LH,R8    PH:FRQ,R3         GET PROCESSOR FREQ
         STH,R8   R3                MERGE WITH PROC NUMBER
         STW,R3   S:FPL,R7          ADD TO LIST
         AND,R3   M8                SCRUB BACK TO PROCESSOR NUMBER
         ELSE
         STW,R3   S:FPL,R7          ADD TO LIST
         FIN      PFRQ
         LB,R7    PB:PSZ,R3         GET SIZE OF PROCESSOR
         AWM,R7   S:PRPC            ADD TO PAGE TOTAL
         B        0,R6              RETURN
         END

