*COMDECK  SCHCOM             INTEGRATED SCHEDULER MACROS. 
 SCHCOM   CTEXT  INTEGRATED SCHEDULER MACROS. 
  
  
**               THE INTEGRATED SCHEDULER MACROS PROVIDE
*         PREDEFINED CALLS FOR THE FUNCTIONS OF THE 6000
*         OPERATING SYSTEM INTEGRATED SCHEDULER.
 LDW      SPACE  4
**        LDW - LOAD WELL 
* 
*         FUNCTION - GENERATE AN LDD OR AN LDM DEPENDING ON ADDRESS.
  
  
          PURGMAC LDW 
  
LDW       MACRO  X
          IFLT   X,100B,2 
          LDD    X
          ELSE   1
          LDM    X
LDW       ENDM
 SCHSTOR  SPACE  4
**        SCHSTOR - RESTORE CELLS ON RETURN FROM EVENT OR DELAY STACK.
* 
*         CALL - SCHSTOR A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14 
* 
*                WHERE IN A1 WILL BE STORED THE CONTENTS OF BYTE 4
*                OF THE LAST WORD OF THE PP MSG BUFFER, IN A2 THE 
*                CONTENTS OF BYTE 3, ... IN A14 WILL BE STORED THE LAST 
*                9 BITS OF BYTE 1 OF WORD 4 OF THE MSG BUFFER 
  
  
          PURGMAC SCHSTOR 
  
SCHSTOR   MACRO  A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14 
          LOCAL  A,STOR 
STOR      MACRO  X
A         SET    A-1
          IFLT   A,0
          LDD    D.T5 
          CRD    D.T0 
          SOD    D.T5 
A         SET    4
          ENDIF 
          IFC    NE,*X**,2
          LDD    D.T0+A 
          STM    X
STOR      ENDM
          LDD    D.PPIR 
          ADN    W.PPMES6 
          STD    D.T5 
A         SET    0
          STOR   A1 
          STOR   A2 
          STOR   A3 
          STOR   A4 
          STOR   A5 
          STOR   A6 
          STOR   A7 
          STOR   A8 
          STOR   A9 
          STOR   A10
          STOR   A11
          STOR   A12
          STOR   A13
          IFC    NE,*A14**
A         SET    A-1
          LDD    D.T0+A 
          LPC    777B 
          STM    A14
          ENDIF 
          ENDM
 SCHSAVE  SPACE  4
**        SCHSAVE - STORE IN PP MSG BUFFER THE CONTENTS OF THE CELLS
*                   SPECIFIED IN THE CALL.
* 
*         CALL - SCHSAVE A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14 
* 
*                WHERE THE CONTENTS OF CELL A1 WILL BE STORED IN BYTE 4 
*                OF THE LAST WORD OF THE PP MSG BUFFER, CONTENTS OF A2
*                IN BYTE 3, ... 
*                NOTE - ONLY THE 9 LOWER BITS OF A14 WILL BE STORED 
*                IN BYTE 1 OF WORD 4 OF THE PP MSG BUFFER AS THE TOP 3
*                BITS ARE USED AS REENTRY FLAGS BY  ENTRY34.
  
  
          PURGMAC SCHSAVE 
  
SCHSAVE   MACRO  A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14 
          LOCAL  A,SAV
SAV       MACRO  X
A         SET    A-1
          IFLT   A,0
          LDD    D.T5 
          CWD    D.T0 
          SOD    D.T5 
          CRD    D.T0 
A         SET    4
          ENDIF 
          IFC    NE,*X**,2
          LDM    X
          STD    D.T0+A 
SAV       ENDM
          LDD    D.PPIR 
          ADN    W.PPMES6 
          STD    D.T5 
          CRD    D.T0 
A         SET    5
          SAV    A1 
          SAV    A2 
          SAV    A3 
          SAV    A4 
          SAV    A5 
          SAV    A6 
          SAV    A7 
          SAV    A8 
          SAV    A9 
          SAV    A10
          SAV    A11
          SAV    A12
          SAV    A13
          IFC    NE,*A14**
  
*     PRESERVE TOP 3 BITS 
  
A         SET    A-1
          LDD    D.T0+A 
          LPC    7000B
          STD    D.T0+A 
          LDM    A14
          LPC    777B 
          RAD    D.T0+A 
          ENDIF 
          LDD    D.T5 
          CWD    D.T0 
          ENDM
 STREQ    SPACE  4
**        STREQ - REQUEST STORAGE 
* 
*         METHOD - REQUESTED FL/100B FOR THE CONTROL POINT IS ASSUMED 
*         TO BE IN D.T1 FIRST A RESERVED TYPE STORAGE REQUEST IS
*         ISSUED (0004 IN BYTE 3 OF M.RSTOR). 3 REPLIES ARE 
*         POSSIBLE
*                1) REQUEST ACCEPTED, THE STORAGE IS ASSIGNED,ROUTINE 
*                   EXITS 
*                2) REQUEST REJECTED, AND BIT 23 OF PP OUTPUT REGISTER
*                NOT ON. CONTROL IS GIVEN TO C1SO WHICH WILL ATTEMPT TO 
*                CAUSE A JOB SWAP/ROLL OUT. 
*                3) REQUEST REJECTED AND BIT 23 OF PP OUTPUT REGISTER ON
*                THIS BIT BEEING ON INDICATES THAT SCHEDULER IS TRYING
*                TO FREE THE NECESSARY STORAGE. THE ROUTINE HAS TO WAIT 
*                FOR THE SCHEDULER AND SO GOES INTO THE EVENT STACK 
*                AND RELEASES THE PP. WHEN THE SCHEDULER STOPS WORKING
*                ON THE REQUEST ,IT CLEARS BIT S.CPRFL IN W.CPSCH. THIS 
*                TRIGGERS THE REINITIATION OF THE PP FROM THE EVENT 
*                STACK. CONTROL IS GIVEN BACK TO THE ROUTINE WHICH THEN 
*                CHECKS BYTE C.CPRFL OF W.CPSCH. IF =0, SCHEDULER GAVE
*                UP ON THE REQUEST AS A HIGHER PRIORITY REQUEST CAME
*                IN. CONTROL IS GIVEN TO C1SO.
*                             IF NOT = 0, THE STORAGE IS FREE AND 
*                RESERVED FOF THE CONTROL POINT. TO GET ASSIGNED
*                , THE ROUTINE WILL ISSUE A TYPE 03 REQUEST WHICH 
*                WILL AT LAST SATISFY THE REQUEST.
*         NOTE - IT MAY BE THAT , BECAUSE SWAPOUTS ARE TAKING PLACE, THE
*                STORAGE IS NOT IMMEDIATELY ASSIGNED. IN THIS CASE THE
*                ROUTINE GOES IN THE DELAY STACK AND TRY AGAIN UNTIL
*                IT GETS THE STORAGE. 
* 
* 
*         CALL - STREQ NOSWP,REQFL,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13 
*                ,A14 
* 
*                WHERE NOSWP CONTAINS THE ADDRESS TO WHICH CONTROL IS 
*                GIVEN IF THE REQUEST CANNOT BE SATISFIED AND THE JOB IS
*                NOT SWAPPABLE (PRIORITY GT 7001B)
*                IN REQFL , STREQ WILL SAVE THE NEEDED FL 
*                A3,A4,... ARE THE CELLS TO BE SAVED IF THE PROGRAM 
*                HAS TO GO IN THE EVENT OR THE DELAY STACK. 
* 
*         EXIT PARAMETERS - D.RA,D.FL ARE UPDATED, FIELD ACCESS FLAG SET
* 
*         ROUTINES USED - ENTRY34, C1SO 
  
  
          PURGMAC STREQ 
  
STREQ     MACRO  NOSWP,REQFL,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14 
          LOCAL  STREQ,STREQ1,STREQ2,EXIT,SRFL,SWAPOUT
  
          LDD    D.T1 
          STM    REQFL
          LDN    04 
          STD    D.T3 
          LDN    0
          STD    D.T2 
          STD    D.T4 
          LDN    M.RSTOR
          RJM  R.MTR
          LDD    D.T1 
          SBM    REQFL
          NJN  *+3            IF REQUEST REJECTED 
          LJM  STREQ2         REQUEST ACCEPTED, STORAGE ASSIGNED
  
          LDD    D.T3 
          SHN    6
          MJN  *+3            IF SCHEDULER WORKING ON REQUEST 
          LJM  SWAPOUT        CALL 1SO
  
*     GO INTO EVENT STACK UNTIL SCHEDULER IS DONE 
  
STREQ     LDD    D.PPIR 
          ADN    W.PPMES4 
          CRD    D.T0 
          LDC    STREQ1       REENTRY ADDRESS 
          STD    D.T0 
          LDD    D.PPIR 
          ADN    W.PPMES4 
          CWD    D.T0         SAVE REENTRY ADDRESS
          ADK    W.PPMES1-W.PPMES4
          CWD    D.PPIRB
  
          SCHSAVE  NOSWP,REQFL,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14 
  
SRFL      EQU    12*C.CPFLG+S.CPRFL-48
  
          LDC    C.CPFLG*100B+SRFL+F.ESOFF+F.ESCPA
          STD    D.T4 
          LDK    W.CPSCH
          STD    D.T2 
          LDN    0
          STD    D.T1 
          STD    D.T3 
          LDN    M.EESD 
          LJM    EXIT 
  
STREQ1    LDD    D.CPAD 
          ADK    W.CPSCH
          CRD    D.T0 
          LDD    D.T0+C.CPFLG 
          SHN    17-SRFL
          PJN  *+3           IF REQUEST IN PROCESS FLAG CLEARED 
          LJM    STREQ       GO IN EVENT STACK
          LDD    D.T0+C.CPRFL 
          NJN  *+3            IF STORAGE GRANTED
          LJM  SWAPOUT
  
*     STORAGE RESERVED - ISSUE A 03 REQUEST TO GET IT ASSIGNED
  
          ADD    D.FL 
          STD    D.T1 
          STD    D.T5 
          LDN    0
          STD    D.T2 
          STD    D.T4 
          LDN    03 
          STD    D.T3 
          LDN    M.RSTOR
          RJM  R.MTR
          LDD    D.T1 
          SBD    D.T5 
          NJN  *+3            IF STORAGE REQUEST REJECTED 
          LJM  STREQ2 
  
*     GO IN DELAY STACK 
  
          LDD    D.PPIR 
          ADN    W.PPMES4 
          CRD    D.T0 
          LDC    STREQ1      REENTRY ADDRESS
          STD    D.T0 
          LDD    D.PPIR 
          ADN    W.PPMES4 
          CWD    D.T0         SAVE REENTRY ADDRESS
          LDD    D.PPMES1 
          CWD    D.PPIRB
          LDN    P.ZERO 
          CRD    D.T0 
          LDC    8*250        500 MILLISECONDS
          STD    D.T2 
          LDN    M.RPJD 
EXIT      RJM  R.MTR
          LJM  R.IDLE 
  
REQFL     BSSZ   1            SAVE NEEDED FL
  
  
*     CALL 1SO
  
SWAPOUT   LDN    F.JDWCM      WAITING FOR CM STATUS 
          STD    D.Z7 
          C1SO   D.Z7,SWPIR,REQFL,,NOSWP
  
*     MEMORY  ASSIGNED , UPDATE D.RA AND D.FL 
  
STREQ2    RJM    R.RAFL 
          ENDM
 C1SO     SPACE  4
**        C1SO - CALL 1SO 
* 
*         FUNCTION - ISSUE THE CALL TO 1SO AFTER SETTING  THE EVENT 
*                    BIT AND MODIFYING THE JOB STATUS IN THE JOB
*                    DESCRIPTOR.
* 
*         CALL - C1SO JOBST,SWPCALL,NEWFL,FET,NOSWP,CTLBACK 
* 
*                JOBST CONTAINS THE JOB STATUS WHICH IS TO BE STORED IN 
*                THE JOB DESCRIPTOR.
*                SWPCALL IS THE NAME BY WHICH THE CALLING PROGRAM 
*                WILL REFERENCE THE SWAPPER INPUT REGISTER IMAGE WHICH
*                IS DEFINED IN THE BODY OF THE MACRO. 
*                NEWFL IS THE ADDRESS OF A CELL DESCRIBING THE FL TO
*                BE STORED IN THE JOB DESCRIPTOR (USED BY RFL,MEM,1AJ)
*                FET  IS THE ADDRESS OF THE FIRST CELL DESCRIBING AN
*                FET ADDRESS.  IF SPECIFIED, C1SO WILL STORE THE FET
*                ADDRESS IN THE JOB DESCRIPTOR. 
*                NOSWP CONTAINS THE ADDRESS WHERE CONTROL GIVEN IF JOB
*                IS NOT SWAPPABLE (PRIORITY GT 7001B) OR IF THE JOB 
*                STATUS IS NOT 0X (1SO HAS ALREADY BEEN CALLED).  IF
*                NOT SPECIFIED THE PP IS PUT INTO RECALL. 
  
*                CTLBACK IF NON NULL INDICATES THAT CALLING PROGRAM 
*                WANTS CONTROL BACK AFTER 1SO  CALL HAS BEEN PLACED 
*                IN PP INPUT REGISTER 
* 
  
*         ENTRY PARAMETERS
* 
*                SWPCALL DEFINED IN C1SO IS THE SKELETON OF THE 
*                SWAPPER INPUT REGISTER AS IT WILL BE PASSED BY THIS
*                ROUTINE . IT CONTAINS THE SWAPPER NAME AND THE 
*                CONTROL POINT NUMBER WHICH IS TO BE SWAPPED/ROLLED 
*                OUT . IT IS THE CALLING PROGRAM
*                RESPONSIBILITY TO SET THE APPROPRIATE FLAGS IN SWAPCALL
*                AS NEEDED BY THE SWAPPER.
*                ALSO THE PP MSG BUFFER IS EXPECTED TO CONTAIN ALL
*                THE INFORMATIONS WHICH ARE TO BE SAVED ACROSS THE
*                SWAPPER CALL (THE EXACT FORMAT IS DESCRIBED IN M.EES 
*                EXTERNAL SPECS).HOWEVER THIS ROUTINE USES THE UPPER
*                3 BITS OF BYTE 1 OF WORD 4 OF THE PP MSG BUFFER TO 
*                STORE REENTRY FLAGS. HOWEVER IF A TIME RECALL IS REQUES
*                -TED, WORDS 4 THRU 6 OF THE MESSAGE BUFFER ARE ZEROED
*                AS THE CALLING PROGRAM SHOULD RESTART AS IF IT WAS 
*                CALLED FOR THE FIRST TIME
* 
*         ROUTINES USED OR ASSUMED - ENTRY34
  
  
          PURGMAC C1SO
  
C1SO      MACRO  JOBST,SWPCALL,NEWFL,FET,NOSWP,CTLBACK
          LOCAL  SWP1,SWP1A,SWP1B,SWP1C,SWP1D,SWP1E 
          LOCAL  SWP2,SWP2A,SWP3
          LOCAL  ABT
          LOCAL  SEVNT,SEVJST,JSTMASK,EVNTMASK
          LOCAL  JOBSTAT
  
SEVNT     EQU    S.CPEVNT+12*C.CPEVNT-48
EVNTMASK  BIT    SEVNT
SEVJST    EQU    S.EVJST-36 
JSTMASK   BIT    SEVJST 
  
SCREWED   IF     -DEF,SWPENTRY
SWPENTRY  BSS    0            ENTRY POINT FOR EXTERNAL CALL 
SCREWED   ENDIF 
  
          LDW    JOBST             SAVE JOB STATUS
          STM    JOBSTAT
* 
*     RESERVE CHANNEL AND CHECK IF STATUS IS 0X.  IF NOT 1SO HAS
*     ALREADY BEEN CALLED SO PUT PP IN DELAY STACK. 
* 
          LDN    CH.SCH            RESERVE CH.SCH 
          RJM  R.RCH
* 
          LDD    D.CPAD            READ W.CPSCH TO D.T0 
          ADK    W.CPSCH
          CRD    D.T0 
          LDD    D.T0+C.CPJDA      READ W.JDMGR TO D.Z1 
          LPN    77B
          SHN    12 
          ADD    D.T0+C.CPJDA+1 
          ZJN  SWP1                JUMP IF JDT ADDR = 0 (SYSTEM JOB)
          ADK    W.JDMGR
          CRD    D.Z1 
          LDD    D.Z1+C.JDJST 
          SHN    -9 
          NJN  SWP1                JUMP IF STATUS NOT 0X
          LJM  SWP1C               JUMP IF STATUS 0X
* 
*     PUT PP INTO DELAY STACK UNLESS THE PARAMETER NOSWP IS SPECIFIED 
* 
SWP1      LDN    CH.SCH            DROP CH.SCH
          RJM  R.DCH
* 
NSWP      IFC    NE,*NOSWP**       ASSEMBLE IF NOSWP SPECIFIED
SWP1A     LDW    NOSWP
          STD    D.T1 
          LJM  0,D.T1              JUMP TO ADDR NOSWP 
NSWP      ENDIF 
* 
          LDN    P.ZERO            ZERO W.PPMES4 - W.PPMES6 
          CRD    D.T0 
          LDD    D.PPIR 
          ADK    W.PPMES4 
          CWD    D.T0 
SWP1B     ADN    1
          CWD    D.T0 
          ADN    1
          CWD    D.T0 
          LDD    D.PPMES1 
          CWD    D.PPIRB
          LDC    4*500             500 MILLISECOND RECALL 
          STD    D.T2 
          LDN    M.RPJD            REQ PP JOB AND DROP PP 
          RJM  R.MTR
          LJM  R.IDLE 
* 
*     JDT STATUS = 0X.  STORE NEW STATUS AND CHECK FOR LOCKIN.
* 
SWP1C     LDM    JOBSTAT           STORE STATUS 
          SHN    6
          RAD    D.Z1+C.JDJST 
* 
          LDD    D.T0+C.CPJQP      CHECK QUEUE PRIORITY FOR LOCKIN
          ADC    -7002B 
          PJN  SWP1D               JUMP IF LOCKED IN
          LJM  SWP1E               JUMP IF NOT LOCKED IN
* 
*     JOB LOCKED IN.  IF NOSWP SPECIFIED EXIT, ELSE WRITE NEW STATUS
*     TO W.JDMGR, SET S.EVJST IN W.PPMES4 AND GO INTO RECALL. 
* 
SWP1D     EQU    *
* 
          IFC    NE,*NOSWP**,1
          UJK  SWP1                JUMP IF EXIT ADDR NOSWP
* 
          LDD    D.T0+C.CPJDA      WRITE NEW STATUS TO W.JDMGR
          LPN    77B
          SHN    12 
          ADD    D.T0+C.CPJDA+1 
          ADK    W.JDMGR
          CWD    D.Z1 
* 
          LDN    CH.SCH            DROP CHANNEL 
          RJM  R.DCH
* 
          LDN    P.ZERO            SET BIT S.EVJST IN W.PPMES4
          CRD    D.T0 
          LDK    JSTMASK
          STD    D.T1 
          LDD    D.PPIR 
          ADK    W.PPMES4 
          CWD    D.T0 
          LDN    0
          STD    D.T1 
          LDD    D.PPIR 
          ADK    W.PPMES4 
          LJM  SWP1B               JUMP TO GO INTO RECALL 
* 
*     JOB NOT LOCKED IN.  STORE INFO IN JDT.
* 
SWP1E     EQU    *
  
*     STORE FET ADDRESS IN JOB DESCRIPTOR 
  
          IFC    NE,*FET**
          LDW    FET+1
          STD    D.Z1+C.JDTIN+1 
          LDD    D.Z1+C.JDTIN 
          LPN    77B
          ZJN  *+3
          LJM  ABT            TILT
  
          LDW    FET
          LPN    77B
          RAD    D.Z1+C.JDTIN 
          ENDIF 
          LDD    D.T0+C.CPJDA 
          LPN    77B
          SHN    12 
          ADD    D.T1+C.CPJDA 
          ADN    W.JDMGR
          CWD    D.Z1 
  
          IFC    NE,*NEWFL**
          ADC    W.JDSWP-W.JDMGR
          CRD    D.Z1        READ SWAPPER WORD IN JOB DESCRIPTOR
          LDD    D.Z1+C.JDFL
          ZJN  *+3
          LJM  ABT            TILT
  
*     STORE NEW FL IN JOB DESCRIPTOR
  
          LDM    NEWFL
          ZJN  SWP2 
          STD    D.Z1+C.JDFL
          LDD    D.T0+C.CPJDA 
          LPN    77B
          SHN    12 
          ADD    D.T1+C.CPJDA 
          ADN    W.JDSWP
          CWD    D.Z1 
          ENDIF 
* 
*     SET EVENT BIT IN W.CPSWP AND DROP CH.SCH
* 
SWP2      LDD    D.CPAD            READ W.CPSWP 
          ADK    W.CPSWP
          CRD    D.T0 
          LDD    D.T0+C.CPEVNT     SET S.CPEVNT 
          LPC    -EVNTMASK
          ADK    EVNTMASK 
          STD    D.T0+C.CPEVNT
          LDD    D.CPAD 
          ADK    W.CPSWP
          CWD    D.T0 
* 
          LDN    CH.SCH            DROP CH.SCH
          RJM  R.DCH
* 
*     SET S.EVJST IN W.PPMES4 AND PUT PP INTO EVENT STACK 
* 
          LDD    D.PPIR 
          ADN    W.PPMES4 
          CRD    D.T0 
          LDD    D.T1 
          LPC    -JSTMASK 
          ADK    JSTMASK
          STD    D.T1         SET FLAG TO INDICATE JOB STATUS MODIF.
          LDD    D.PPIR 
          ADN    W.PPMES4 
          CWD    D.T0 
          ADK    W.PPMES1-W.PPMES4
          CWD    D.PPIRB
          RJM    R.RAFL 
          RJM    R.TAFL 
          LDC    C.CPEVNT*100B+SEVNT+F.ESOFF+F.ESCPA
          STD    D.T4 
          LDK    W.CPSWP
          STD    D.T2 
          LDN    0
          STD    D.T1 
          STD    D.T3 
  
*     CALL 1SO, UNLESS A ROLLOUT IS REQUESTED AND THE C.P. FL IS
*     LESS THAN IP.ROFL 
  
          LDM    SWPCALL+4
          LPN    20B
          ZJN  SWP2A               IF NOT A ROLLOUT 
          LDD    D.FL 
          SHN    6
          ADC    -IP.ROFL 
          PJN  SWP2A               IF FL LARGE ENOUGH TO JUSTIFY A ROLL 
          LDN    M.EESD 
          RJM  R.MTR
          LJM  R.IDLE 
  
SWP2A     LDN    M.EES
          RJM  R.MTR
          LDN    1
          STD    D.T0 
          LDD    D.CPAD 
          SHN    -7 
          RAM    SWPCALL+1   STORE CONTROL POINT NUMBER 
          LDD    D.PPIR 
          CWM    SWPCALL,D.T0 
          IFC    NE,*CTLBACK**,2
          LJM    SWP3 
          ELSE   1
          LJM  R.IDLE 
* 
*     ABT - ISSUE BAD MTR REQUEST 
* 
ABT       LDN    CH.SCH 
          RJM  R.DCH
          LDN    M.KILL 
          RJM  R.MTR
* 
*     MEMORY CELLS
* 
JOBSTAT   BSSZ   1                 HOLDS JOB STATUS 
* 
SWPCALL   DATA   2L1S 
          DATA   1LO
          BSSZ   3
  
SWP3      BSS    0            FALL THROUGH
          ENDM
 ENTRY34  SPACE  4
**        ENTRY34  - PPENTRY MACRO UPDATED TO ACCOMODATE THE EVENT
*                STACK FEATURE AND THE INTEGRATED SCHEDULER - IT SHOULD 
*                BE USED IN CONJUNCTION WITH THE MACRO C1SO - IF USED 
*                INDEPENDENTLY OF C1SO THE CONVENTIONS DESCRIBED MUST BE
*                CAREFULLY FOLLOWED 
* 
*         FUNCTION  - THE ROUTINE WILL  1) INITIALIZE D.FL,D.RA,D.PPIRB 
*                                       2) RESTORE CELLS CONTENTS AS
*                                          SPECIFIED IN CALL
*                                       3) IF ERROR FLAG IS SET IN C.P. 
*                                          AREA ,JUMP AS SPECIFIED IN 
*                                          CALL 
*                                       4) IF REENTRY ADDRESS DEFINED 
*                                         (NON ZERO),JUMP TO IT, OTHER- 
*                                          WISE CONTROL IS GIVEN TO THE 
*                                          NEXT STATEMENT 
*                                       5) FIELD ACCESS FLAG IS SET 
* 
*         CALL -  ENTRY34  ERREXIT,A1,A2,.......A14 
* 
*                A1,....A14 ARE THE ADDRESSES OF THE CELLS WHICH ARE TO 
*                BE RESTORED FROM THE MSG BUFFER AREA 
* 
* 
*         CONVENTIONS - THE PP MSG BUFFER IS EXPECTED TO HAVE THE 
*                       FOLLOWING FORMAT
* 
*                WD4  * * * * * * * * * * * * * * * * 
*                     *REEAD*F*C14* C13 *  C12*  C11* 
*                     * * * * * * * * * * * * * * * * 
* 
*                WD5  * * * * * * * * * * * * * * * * 
*                     * C10 *  C9 *  C8 *  C7 *  C6 * 
*                     * * * * * * * * * * * * * * * * 
* 
*                WD6  * * * * * * * * * * * * * * * * 
*                     * C5  * C4  * C3  * C2  * C1  * 
*                     * * * * * * * * * * * * * * * * 
* 
*                REEAD IS THE ADDRESS TO WHICH CONTROL WILL BE PASSED 
*         AT END OF EXECUTION 
*                F, 3 BIT FIELD, CONTAINS FLAGS USED BY ENTRY34 
*                C14 IS A 9 BIT FIELD WHICH WILL BE STORED IN A14-
*                C1 THRU C13 ARE THE VALUES TO BE STORED IN A1...A13
  
  
          PURGMAC ENTRY34 
  
ENTRY34   MACRO  ERREXIT,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14 
          LOCAL  ENTRY,ENTRY1,ENTRY2,SEVJST 
          LOCAL  ENTRY3 
  
          RJM  R.RAFL 
          LDD    D.PPIR 
          CRD    D.PPIRB
          ADN    W.PPMES4 
          CRD    D.T0        WORD 3 OF MSG BUFFER 
          LDD    D.T0 
          STM    ENTRY2 
  
*     CLEAR REENTRY INFORMATIONS
  
          LDN    0
          STD    D.T0 
          LDD    D.T1 
          STD    D.T5 
          LPC    777B 
          STD    D.T1 
          LDD    D.PPIR 
          ADN    W.PPMES4 
          CWD    D.T0 
          LDD    D.T5 
  
SEVJST    EQU    S.EVJST-36 
  
          SHN    17-SEVJST
          MJN  *+3           IF THE JOB STATUS WAS MODIFIED BY THIS 
*                            PROGRAM
          LJM  ENTRY
  
          LDN    CH.SCH 
          RJM  R.RCH
          LDD    D.CPAD 
          ADK    W.CPSCH
          CRD    D.T0 
          LDD    D.T0+C.CPJDA 
          LPN    77B
          SHN    12 
          ADD    D.T1+C.CPJDA 
          ZJN    ENTRY3 
          ADN    W.JDMGR     (A)= JOB DESCRIPTOR MGR WORD ADDRESS 
          CRD    D.Z1 
          LDD    D.Z1+C.JDJST 
          LPC    777B        CLEAR UPPER 3 BITS 
          STD    D.Z1+C.JDJST 
          LDD    D.T0+C.CPJDA 
          LPN    77B
          SHN    12 
          ADD    D.T1+C.CPJDA 
          ADN    W.JDMGR
          CWD    D.Z1 
 ENTRY3   LDN    CH.SCH 
          RJM  R.DCH
ENTRY     EQU    *
ENT       IFC    NE,*A1** 
  
*    RESTORE CELLS AS SPECIFIED IN MACRO CALL 
  
          SCHSTOR  A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14 
ENT       ENDIF 
  
*     CHECK ERROR FLAG
  
          LDD    D.CPAD 
          ADK    W.CPSTAT 
          CRD    D.T0 
          LDD    D.T0+C.CPEF
          ZJN  ENTRY1        IF ERROR FLAG NOT SET
  
          IFC    NE,*ERREXIT**,1
          LJM  ERREXIT
  
ENTRY1    LDM    ENTRY2       LOAD REENTRY ADDRESS
          ZJN  *+3           IF NO REENTRY SPECIFIED
          LJM  ** 
  
ENTRY2    EQU    *-1
  
          ENDM
 SCHLOK   SPACE  4
*         SCHLOK - A SYSTEM MACRO CONTAINING 3 SUBROUTINES WHICH CAN
*         BE CALLED TO RESERVE OR RELEASE THE CP-PP INTERLOK BITS 
*         IN WORDS T.SCHPP AND T.SCHCP OF CMR.
*         THESE SUBROUTINES USE DIRECT CELLS D.T0 - D.T6. 
*         AT ENTRY THE A REGISTER MUST CONTAIN THE NUMBER OF THE
*         CONTROL POINT FOR WHICH THE INTRERLOCK IS TO BE OBTAINED
  
  
          PURGMAC SCHLOK
  
SCHLOK    MACRO  GETLOK,CLRLOK,SETEOJ 
* 
          LOCAL  SHN17,SHN1,EOJMASK 
          LOCAL  GETLOK1,GETLOK2,GETLOK3,GETLOK4,GETLOK5,GETLOK6
          LOCAL  GETLOK7,GETLOK8,GETLOK9,GETLOK10 
          LOCAL  CLRLOK1,CLRLOK2, 
          LOCAL  SETEOJ1,SETEOJ2,SETEOJ3
  
EOJMASK   BIT    S.CPEOJ-48+4*C.CPFLG 
SHN17     EQU    1021B             SHN 17 INSTRUCTION 
SHN1      EQU    1001B             SHN 1  INSTRUCTION 
* 
* 
* 
* 
          IFC    NE,*GETLOK** 
* 
*         GETLOK - OBTAIN CP-PP INTERLOCK 
*         ENTRY - A = CONTROL POINT NUMBER
*         EXIT - A = 0 IF INTERLOCK RESERVED
*                A = 1 IF INTERLOCK WAS BUSY
* 
GETLOK    ENM    X
          STD    D.T5              D.T5 = CP NB 
          LDC    SHN17             A = SHN 17 
          SBD    D.T5              A = SHN 17- CP NB
          STM    GETLOK1           STORE SHIFT INSTRUCTION
          STM    GETLOK5
* 
          LDC    SHN1              A = SHN 1
          ADD    D.T5              A = SHN 1+CP NB
          STM    GETLOK3           STORE SHIFT INSTRUCTION
* 
          LDN    10                STORE NB OF TRIES COUNT
          STD    D.T6 
* 
          LDK    T.SCHPP           READ PP WORD 
          CRD    D.T0 
          LDD    D.T3              GET PP BITS
          LPN    77B
          SHN    12D
          ADD    D.T4 
GETLOK1   SHN    **                SHN 17 - CP NB 
          PJN  GETLOK2             JUMP IF PP BIT NOT SET 
          LJM  GETLOK9             JUMP IF PP BIT SET - INTERLOK BUSY 
* 
GETLOK2   ADC    400000B           SET PP BIT 
GETLOK3   SHN    **                SHN 1 + CP NB
          STD    D.T4              STORE PP BITS
          SHN    -12D 
          STD    D.T3 
          LDK    T.SCHPP
          CWD    D.T0              WRITE PP WORD
* 
GETLOK4   LDK    T.SCHCP           READ CP WORD 
          CRD    D.T0 
          LDD    D.T3              LOAD CP BITS 
          LPN    77B
          SHN    12 
          ADD    D.T4 
GETLOK5   SHN    **                SHN 17 - CP NB 
          PJN  GETLOK7             JUMP IF CP BIT OFF - INTRLK OBTAINED 
* 
          LDN    15                CP BIT SET - DELAY 30 MICROSECS
GETLOK6   SBN    1
          NJN  GETLOK6
          SOD    D.T6              DECREMENT NB OF TRIES COUNT
          NJN  GETLOK4             JUMP IF NON-ZERO 
          UJN  GETLOK8             JUMP TO DROP INTERLOCK 
* 
GETLOK7   LDN    0                 INTERLOCK OBTAINED. SET A=0. 
          UJN  GETLOK10            EXIT 
* 
GETLOK8   LDD    D.T5              LOAD CP NB 
          RJM  CLRLOK              JUMP TO CLEAR PP BIT 
* 
GETLOK9   LDN    1                 INTERLOCK WAS BUSY. SET A=1. 
GETLOK10  UJK  GETLOKX             EXIT 
* 
          ENDIF 
* 
* 
* 
* 
* 
          IFC    NE,*CLRLOK** 
* 
*         CLRLOK - RELEASE CP-PP INTERLOCK
* 
*         ENTRY - A = CONTROL POINT NUMBER
* 
CLRLOK    ENM    X
          STD    D.T5              D.T5 = CP NB 
          LDC    SHN17             A = SHN 17 
          SBD    D.T5              A = SHN 17 - CP NB 
          STM    CLRLOK1           STORE SHIFT INSTRUCTION
* 
          LDC    SHN1              A = SHN 1
          ADD    D.T5              A = SHN 1 + CP NB
          STM    CLRLOK2           STORE SHIFT INSTRUCTION
* 
          LDK    T.SCHPP           READ PP WORD 
          CRD    D.T0 
          LDD    D.T3              LOAD PP BITS 
          LPN    77B
          SHN    12D
          ADD    D.T4 
CLRLOK1   SHN    **                SHN 17 - CP NB 
          LPC    377777B           CLEAR PP BIT FOR THIS CONTROL POINT
CLRLOK2   SHN    **                SHN 1 + CP NB
          STD    D.T4              STORE PP BITS
          SHN    -12D 
          STD    D.T3 
          LDK    T.SCHPP
          CWD    D.T0              WRITE PP WORD
* 
          UJK    CLRLOKX           EXIT 
* 
          ENDIF 
* 
* 
* 
* 
* 
          IFC    NE,*SETEOJ** 
* 
*         SETEOJ - SUBROUTINE TO SET S.CPEOJ BIT
*         AT ENTRY D.CPAD CONTAINS CONTROL POINT ADDRESS
* 
SETEOJ    ENM    X
* 
SETEOJ1   LDN    CH.SCH            RESERVE CH.SCH 
          RJM  R.RCH
* 
          LDD    D.CPAD 
          SHN    -7 
          RJM  GETLOK              JUMP TO RESERVE INTERLOCK
          ZJN  SETEOJ3             JUMP IF INTERLOCK OBTAINED 
          LDN    CH.SCH            INTERLOCK BUSY - DROP CH.SCH 
          RJM  R.DCH
          LDC    4000D             DELAY 8  MILLISECONDS
SETEOJ2   SBN    1
          NJN  SETEOJ2
          UJN  SETEOJ1             JUMP TO TRY AGAIN
* 
SETEOJ3   LDD    D.CPAD            INTERLOCK OBTAINED - READ W.CPSCH
          ADK    W.CPSCH
          CRD    D.T0 
          LDD    D.T0+C.CPFLG 
          LPC    -EOJMASK          CLEAR S.CPEOJ
          ADK    EOJMASK           SET S.CPEOJ
          STD    D.T0+C.CPFLG 
          LDD    D.CPAD 
          ADK    W.CPSCH
          CWD    D.T0              WRITE W.CPSCH
* 
          LDD    D.CPAD            DROP INTERLOCK 
          SHN    -7 
          RJM  CLRLOK 
* 
          LDN    CH.SCH            DROP CH.SCH
          RJM  R.DCH
* 
          UJK  SETEOJX             EXIT 
* 
          ENDIF 
* 
* 
* 
* 
* 
          ENDM
  
  
 SCHCOM   ENDX
