*COMDECK  COMPFA
  
  
**        COMPFA COMDECK
* 
*         CODE TO SET APF FLAG, FIND FNT SLOT, CREATE SKELETON FNT, 
*         AND DETERMINE IF FILE IS AVAILABLE. 
* 
  
          UJN  ATT83C 
* 
*         SET APF FLAG IN APF ENTRY 
* 
OLDAPF    BSS    0
ATT83     RJM  APFADR 
          ADN    1
          CRD    D.T0 
          LDD    D.T0+C.PFLAG 
          ADK    IBIT 
          STD    D.T0+C.PFLAG 
          LDD    CPTFLGS
          LPK    APFF 
          NJN  NEWAPF5C 
          LDK    APFF 
          RAD    CPTFLGS
          RJM  APFADR 
          ADN    1
          CWD    D.T0 
          LDN    CH.APF 
          RJM  R.DCH               DROP APF PSEUDO CHANNEL
ATT83C    BSS    0
  
*         PFM INTERLOCK REMAINS TO BE ON
  
**
*         O) FIND FNT SLOT, ASSURE LFN NOT ALREADY IN USE AND 
*            FILE NOT ALREADY ATTACHED UNDER ANOTHER NAME 
* 
ATT83A    LDN    P.FNT
          CRD    D.Z1              D.Z1=FWA FNT   D.Z2=LWA+1 FNT
          LDN    CH.FNT 
          RJM  R.RCH
* 
ATTLP1    LDD    D.Z1 
          CRD    D.T0 
          LDD    D.T0 
          NJN  ATTLP3 
          LDM    UFNT 
          NJN  ATTLP3A             IF HAVE EMPTY SLOT 
          LDD    D.Z1              ELSE SAVE ADDRESS OF SLOT
          STM    UFNT 
ATTLP3A   LJM  ATTBLA 
* 
ATTLP3    BSS    0
          SBN    77B
          ZJN  ATTLP3A             LINKED FNT WORDS 
          LDD    D.CPAD 
          SHN    -7 
          LMD    D.T0+C.FCPNUM
          LPK    L.CPNUM
          NJN  ATTLP3A
* 
          LDC    LFN               CHECK FOR LFN ALREADY IN USE 
          STD    D.Z4 
          LDN    D.T0 
          STD    D.Z3 
          LDD    D.T0 
          SHN    6
          MJN  ATTLP3A             SET FNT
ATTLP4X   LDI    D.Z4 
          LMI    D.Z3 
          NJN  CONTIN1
          AOD    D.Z4 
          AOD    D.Z3 
          LMN    D.T3 
          NJN  ATTLP4X
          LDI    D.Z4 
          LMI    D.Z3 
          SHN    -6 
CONTIN1   NJN  CONTINUE            IF NON ZERO
* 
ATTBLU1   LDM    MULTIPRU 
          ZJN  NOZERO              DONT ZER ENTRY 
          LDN    P.ZERO 
          CRD    D.T0 
          RJM  APFADR 
          CWD    D.T0 
          ADN    1
          CWD    D.T0 
          LDD    CPTFLGS
          SCK    APFF 
          STD    CPTFLGS
NOZERO1   LDN    CH.FNT 
          RJM  R.DCH
**
*         P) IF LFN ALREADY IN USE, RC=2, *LFN ALREADY IN USE*
*            AND DROP THE PFM INTERLOCK 
* 
          RJM  DPFM                DROP PFM I/L 
          LCN    RC002
          RJM  ERR
* 
NOZERO    RJM  APFLAG 
          UJN  NOZERO1
* 
CONTINUE  BSS    0
* 
ATTLP4A   LDD    D.T0+C.FLINK 
          SHN    17D-S.FLINK       CHECK LINK BIT 
          PJN  ATTLP4B
          LDD    D.T0+C.FLNKAD     CHECK LINKED FNT WORDS FOR APF ORD 
          CRD    D.T0 
          UJN  ATTLP4A
* 
ATTLP4B   LDD    D.T0+C.FAPF
          ZJN  ATTLP5 
          SBM    APFO 
          ZJN  ATTLP6 
ATTLP5    LJM  ATTBLA              WRONG  POINTER 
* 
ATTLP6    BSS    0
          LDN    CH.FNT 
          RJM  R.DCH
          LDD    D.Z1 
          STM    UFNT 
          RJM  APFLAG 
* 
*         IF PURGE BY PFN AND PF ALREADY ATTACHED, CALL PFP BACK
* 
          LDD    CPTFLGS
          LPK    PURPFN 
          NJN  ATTL7E 
          LJM  ATTLP2 
* 
ATTL7E    BSS    0
          LDM    UFNT 
          CRM    LFN,D.PPONE
          LDN    0
          RJM  FDBADR 
          CRD    D.T0 
          LDM    LFN
          STD    D.T0 
          LDM    LFN+1
          STD    D.T1 
          LDM    LFN+2
          STD    D.T2 
          LDM    LFN+3
          SCN    77B
          STD    D.T3 
          LDN    0
          RJM  FDBADR 
          CWD    D.T0 
          RJM  DPFM                DROP PFM I/L 
          LDC    OV.PFP 
          RJM  CALL 
* 
ATTLP2    BSS    0
  
**
*         Q) IF PF ALREADY ATTACHED, RC=24, *PF ALREADY ATTACHED* 
*            AND DROP THE PFM INTERLOCK 
* 
          LDM    FUNCT
          ZJN    ATTLP9 
          LDM    UFNT 
          CRD    D.T0 
          LDM    FUNCT1 
          STD    D.T0+4 
          LDN    0
          RJM    FDBADR 
          CWD    D.T0        RETURN LFN ON PFN ATTACHED ALREADY 
* 
 ATTLP9   BSS    0
          RJM  DPFM                DROP PFM I/L 
          LCN    RC024
          RJM  ERR
* 
ATTBLA    LDN    LE.FNT 
          RAD    D.Z1 
          SBD    D.Z2 
          PJN  ATTBLU 
          UJK  ATTLP1 
* 
ATTBLU    BSS    0
          LDM    UFNT 
          NJN  ATTBLU2
          LDN    CH.FNT            NO FNT SPACE 
          RJM  R.DCH
          LDN    4
          RJM  DELAY
          LJM  ATT83A 
* 
ATTBLU2   BSS    0
  
**
*         R) CREATE SKELETON FNT, SET BUSY
* 
          LDD    D.PPMES1          MOVE LFN 
          CWM    LFN,D.PPONE
          SBN    1
          CRD    D.Z1 
          LDN    P.ZERO            CLEAR FST-S
          CRD    D.Z1+5 
          CRD    D.Z1+10D 
          LDM    MSTORD 
          STD    D.Z1+5            STORE MST ORD IN FNT FOR 1PC 
          LDD    D.PPIRB+1         SET CP NUMBER
          LPN    L.CPNUM
          LMD    D.Z1+C.FCPNUM
          LPN    77B               CLEAR 8 TH CHAR
          LMD    C.FCPNUM+D.Z1
          STD    C.FCPNUM+D.Z1
          LDM    APFO              SET APF ADDRESS
          STD    D.Z1+C.FAPF
          LDM    PERM              SET PERMISSION CODES 
          LPN    17B
          SHN    8
          STD    D.Z1+10D+C.FSC 
          LDN    3                 WRITE 3 WORD FNT/FST 
          STD    D.Z1+17D 
          LDM    UFNT              SET FILE BUSY
          CWM    D.Z1,D.Z1+17D
          LDN    CH.FNT            DROP FNT CHANNEL 
          RJM  R.DCH
          RJM  APFADR 
          ADN    1
          CRD    D.T0 
          CRM    APF2,D.PPONE 
          LDD    D.T0+C.PFLAG 
          LPK    ABIT 
          NJN  EAQ
**
*         S) DETERMINE IF FILE AVAILABLE
*                CONTROL PERMISSION IMPLIES EXCLUSIVE ACCESS NEEDED 
*                            I.E. BOTH COUNTS MUST EQUAL ZERO 
* 
*                MODIFY PERMISSION IMPLIES EXCLUSIVE ACCESS UNLESS
*                IP.MREWR=1  MULTIPLE REWRITES ALLOWED
*                IF IP.MREWR=0 AND USER SPECIFIES RW.NE.0 
*                THEN MULTI-READ WITH SINGLE REWRITE ALLOWED
* 
*                WRITE PERMISSION IMPLIES EXCLUSIVE ACCESS
*                UNLESS USER SPECIFIES RW.NE.0 THEN 
*                MULTIREAD WITH SINGLE WRITE ALLOWED
* 
*                READ PERMISSION IMPLIES MULTI-ACCESS 
*                HOWEVER THE FOLLOWING CONDITIONS MUST BE MET 
*                1) EABIT AND RBIT OFF
*                2) IF FRBT.NE.0  OBIT MUST BE OFF
* 
          LDM    PERM 
          LPN    10B
          ZJN  MPERM
EACCESS   LDD    D.T0+C.PFCNT 
          ADD    D.T0+C.PFCNT2
          NJN  EAQ
          LDD    D.T0+C.PFLAG 
          ADK    EABIT
          STD    D.T0+C.PFLAG 
MPERM00   LJM  AODCNT 
* 
EAQ       LJM  QUEUE
* 
EACCESS0  LDM    PERM 
          SCN    20B
          ADN    20B
          STM    PERM 
          UJN  EACCESS
* 
MPERM     LDM    PERM 
          LPN    6B                CHECK FOR MODIFY AND EXTEND  PERM
          ZJN  RPERM
          LDD    D.T0+C.PFLAG 
          LPK    MBIT+WBIT         CHECK MODIFY AND WRITE BITS
          NJN  EAQ
          LDN    RWC               REWRITE KEYWORD CODE 
          RJM  CHKFDB 
          MJN  EACCESS0 
          LDM    PERM 
          IFEQ   IP.MREWR,0 
          LPN    MBIT+WBIT
          ELSE
          LPN    WBIT              MULTIPLE REWRITE 
          ENDIF 
          RAD    D.T0+C.PFLAG 
RPERM     LDD    D.T0+C.PFLAG 
          LPK    EABIT
          NJN  RPERM2 
RPERM5    LDD    CPTFLGS
          LPK    IGNRBIT
          NJN  EAQ1                GO GET FILE EVEN IF RBIT IS SET
          LDD    D.T0+C.PFLAG 
          LPK    RBIT 
          NJN  RPERM2 
EAQ1      BSS    0
          LDD    D.T0+C.PFLAG 
          LPK    SBIT 
          NJN  AODCNT 
          LDM    PERM 
          LPN    2
          NJN  APFOUT 
AODCNT    LDD    D.T0+C.PFRBT 
          ZJN  APFOUT              NO FRBT SPECIFIED
          LDD    D.T0+C.PFLAG      CHECK FOR OBSOLETE FRBT
          LPK    OBIT              TREAT LIKE FRBT=0
RPERM2    NJN  QUEUE
          LDD    CPTFLGS
          SCK    CHAINCM
          ADK    CHAINCM
          STD    CPTFLGS
APFOUT    AOD    D.T0+C.PFCNT 
          RJM  APFADR 
          ADN    1
          CWD    D.T0 
          LJM  ATT91A 
  
**        END - COMPFA COMDECK
