*COMDECK RSVAPF 
          CTEXT - RSVAPF  RESERVE APF SLOT
          LIST   X
  
  
**        RSVAPF COMDECK
* 
*         CODE TO RESERVE AN EMPTY SLOT IN APF TABLE, IT WILL 
*         BE RETURNED IF NOT NEEDED LATER 
* 
  
RSVAPF    BSS    0
          LDN    CH.APF 
          RJM  R.RCH               GET APF PSEUDO-CHANNEL 
          LDN    1
          STM    APFO 
RSVAPF1   BSS    0
          RJM  APFADR 
          ADN    1
          CRD    D.T0              READ 2ND WORD OF APF ENTRY 
          LDD    D.T0+C.PFCY
          NJN  RSVAPF2             IF NOT EMPTY 
* 
          LDD    D.T0+C.PFLAG 
          LPN    RSVFLAG
          NJN  RSVAPF2             IF RESERVED FLAG SET 
* 
          LDM    MSTORD            GET MST ORDINAL
          SHN    6
          ADN    RSVFLAG           SET APF RESERVED FLAG
          STD    D.T0+C.PFLAG 
          RJM  APFADR 
          ADN    1
          CWD    D.T0 
          LDN    CH.APF            DROP APF PSEUDO-CHANNEL
          RJM  R.DCH
          LDD    CPTFLGS
          SCK    RAPFF
          ADK    RAPFF             SET APF SLOT RESERVED FLAG 
          STD    CPTFLGS
          LJM  RSVAPF6
* 
RSVAPF2   AOM    APFO              INCREMENT APF ORDINAL
          SBM    PPFM1+C.APFL 
          MJN  RSVAPF1             NOT END OF TABLE YET 
* 
**        IF APF FULL, SWAP OUT JOB - LAST APF ENTRY
*         IS RESERVED FOR THIS PURPOSE
* 
  
RSVAPF3   LDM    PPFM1+C.APFL      USE LAST APF ENTRY FOR APF FULL
          STM    APFO 
          RJM  APFADR 
          ADN    1
          CRD    D.T0 
          LDD    D.T0+C.PFLAG 
          LPK    IBIT              CHECK IF APF FLAG ON 
          ZJN  RSVAPF4
* 
          LDN    CH.APF 
          RJM  R.DCH
  
  
          LDK    FLAGDLY
          RJM  DELAY               WAIT FOR APF FLAG
  
  
          LDN    CH.APF 
          RJM  R.RCH
          UJN  RSVAPF3
* 
RSVAPF4   LDK    IBIT              SET APF FLAG 
          STD    D.T0+C.PFLAG 
          LDN    1
          STD    D.T0+C.PFCY
          RJM  APFADR 
          ADN    1
          CWD    D.T0 
          LDD    CPTFLGS
          SCK    APFF 
          ADK    APFF 
          STD    CPTFLGS
          LDN    CH.APF 
          RJM  R.DCH               SWAPOUT-WAITING FOR APF SPACE
          LCN    2
          RJM  DELAY
  
PFATST    IF     -DEF,ATTACH
          RJM  JSTMOD 
PFATST    ELSE
          RJM  CALL3PA
PFATST    ENDIF 
  
          IFANY  (CATALOG),1
PFCRSTRT  BSS    0
          RJM  ERRFLG 
          ZJN  RSVAPF5
* 
          RJM  ERR
* 
RSVAPF5   LJM  RSVAPF 
* 
RSVAPF6   BSS    0
**        END - RSVAPF COMDECK
          LIST   *
          ENDX
