*COMDECK NEWAPF 
          CTEXT - NEWAPF  BUILD A NEW APF ENTRY 
          LIST   X
  
  
**        NEWAPF COMDECK
* 
*         CODE TO CREATE AN APF ENTRY IF ONE DOES NOT ALREADY 
*         EXIST, IN WHICH CASE, IT RETURNS TO OLDAPF AND THE
*         RESERVED EMPTY SLOT IN APF IS RELEASED
* 
  
NEWAPF    BSS    0
          LDN    0
          STM    MULTIPRU 
          LDM    APFO 
          STM    EMAPFO            SAVE RESERVED EMPTY SLOT ORDINAL 
          LDN    CH.APF 
          RJM  R.RCH               GET APF PSEVDO-CHANNEL 
          LDN    1
          STM    APFO 
NEWAPF1   BSS    0
          RJM  APFADR 
          CRD    D.FNT
          ADN    1
          CRD    D.T0 
          LDD    D.T0+C.PFCY
          NJN  NEWAPF3             IF ENTRY NOT EMPTY 
* 
NEWAPF2   AOM    APFO              INCREMENT APF ORDINAL
          SBM    PPFM1+C.APFL 
          MJN  NEWAPF1             NOT END OF APF TABLE YET 
* 
          LJM  NEWAPF4             APF ENTRY NOT EXIST
* 
NEWAPF3   BSS    0                 CHECK IF APF ALREADY THERE 
          SBD    CYCLE             COMPARE CYCLE
          NJN  NEWAPF2
* 
          LDD    POINT             COMPARE PFD POINTER
          SBD    D.FNT+C.PFD1 
          NJN  NEWAPF2
* 
          LDD    POINT+1
          SBD    D.FNT+C.PFD2 
          NJN  NEWAPF2
* 
          LDD    POINT+2
          SBD    D.FNT+C.PFD3 
          NJN  NEWAPF2
* 
          LDD    D.FNT+C.PFD4 
          SHN    -6 
          SBD    POINT+3
          NJN  NEWAPF2
* 
          LDM    APFO 
          STM    APFORD 
          LDM    EMAPFO 
          STM    APFO 
          LDD    D.T0+C.PFLAG      APF ENTRY PRESENT
          LPN    IBIT 
          NJN  NEWAPF3A            APF FLAG ON
* 
          IF     DEF,CATALOG
*                            CHECK FOR APF WAITING ON OTHER MF
          LDD    D.T0+C.PFLAG 
          LPC    APOM 
          ZJN    NEWAPF3B    IF NOT WAITING ON OTHER MF 
          LDK    WOMFDLY     DELAY ON APF BIT S.APOM
          STM    DELAYPRM 
          UJN    NEWAPF3A    DELAY AND RESTART
  
NEWAPF3B  BSS    0
          ELSE
          ENDIF 
          RJM  RELAPF              RELEASE RESERVED APF SLOT
          LDM    APFORD 
          STM    APFO 
  
          IF     DEF,LPFFMT 
          RJM  CTR                 CHECK TRANSPF AND REPLACE BIT
          ZJN  NEWAPF3B            IF TRANSPF AND REPLACE MODE
          LJM  OLDAPF 
  
NEWAPF3B  STM    MULTIPRU 
          LJM  NEWAPF5B 
  
          ELSE
          LJM  OLDAPF 
          ENDIF 
  
**        IF APF PRESENT AND APF FLAG IS ON, DROP APF CHANNEL 
*         AND PFM INTERLOCK TO WAIT FOR FLAG CLEARED, AND THEN
*         RETURNS TO RESTART (ADDRESS IN MAIN PROGRAM)
* 
NEWAPF3A  BSS    0
          LDN    CH.APF 
          RJM  R.DCH
  
          IF     DEF,ATTACH,1 
          RJM  DPFM                DROP PFM INTERLOCK 
  
          IF     DEF,LOA,2
          RJM  DPFM 
          RJM  JSTR 
  
          LDC    FLAGDLY
          IF     DEF,CATALOG,1
DELAYPRM  EQU    *-1         *INSTR MODIFIED IF APF WAITING ON OTHER MF 
          RJM  DELAY
  
          IF     DEF,LOA,1
          RJM  JRSTR
  
          LJM  RESTART
  
NEWAPF4   BSS    0                 CREATE AN APF ENTRY
  
ARCHR     IF     DEF,LOA
          LDM    JTAB+2 
          SHN    7D 
          PJN  NEWAPF4A            IF NOT IN ARCHIVE RETRIEVAL MODE 
          LDN    CH.APF 
          RJM  R.DCH
          LDN    0                 APFO=0 IS SPECIAL CASE 
          STM    APFO              FLAG FOR OVERLAY 3LF TO ISSUE
          UJK  LPF15D              IMPROPER ARCHIVE RETRIEVAL CALL
ARCHR     ENDIF 
  
NEWAPF4A  BSS    0
          LDN    1
          STM    MULTIPRU 
          LDD    POINT             STORE PFD POINTER
          STD    D.FNT+C.PFD1 
          LDD    POINT+1
          STD    D.FNT+C.PFD2 
          LDD    POINT+2
          STD    D.FNT+C.PFD3 
          LDD    POINT+3
          SHN    6
          STD    D.FNT+C.PFD4 
          LDN    0
          STD    D.FNT+C.PFQ ZERO POINTER TO PF QUEUE.
          LDN    P.ZERO 
          CRD    D.FNT+5
          LDK    IBIT              SET APF FLAG 
          STD    D.FNT+5+C.PFLAG
          LDC    SYSTEM 
          STD    TEMP1
          LDC    OWNER
          STD    TEMP2
          RJM  COMPARE
          NJN  NEWAPF5             IF  NOT SYSTEM PERMANENT FILE
          LDK    SBIT 
          RAD    D.FNT+5+C.PFLAG   SET SYSTEM FLAG
NEWAPF5   LDD    CYCLE
          STD    D.FNT+5+C.PFCY    STORE CYCLE NUMBER 
          LDN    2
          STD    REMAIN 
          LDM    EMAPFO            RESERVED EMPTY SLOT IN APF 
          STM    APFO 
          RJM  APFADR 
          CWM    D.FNT,REMAIN 
* 
NEWAPF5B  LDD    CPTFLGS
          SCK    RAPFF             CLEAR APF SLOT RESERVED FLAG 
          STD    CPTFLGS
          LPK    APFF 
          ZJN  NEWAPF6
* 
NEWAPF5C  LDN    CODE13 
          RJM  ERR
* 
NEWAPF6   LDK    APFF 
          RAD    CPTFLGS           SET INTERNAL INTERLOCK ON APF FLAG 
  
          IF     -DEF,LOA,2 
          LDN    CH.APF 
          RJM  R.DCH               DROP APF PSEUDO-CHANNEL
  
**        END - NEWAPF COMDECK
          LIST   *
          ENDX
