*COMDECK  COMPFC
  
  
**        COMPFC
* 
* 
*         CODE TO PROCESS RW AND MR PARAMETERS, STORE APF ORDINAL IN
*         FNT, AND CALL 1FC TO CREATE A PFC ENTRY.
* 
*         SUBROUTINES CHKPER, WPFD, AND ISCYOK
* 
**
*         AK) PROCESS RW AND MR PARAMETERS
*                IF RW, TURN OFF CONTROL PERM IN FNT
*                       AND EXCLUSIVE ACCESS BIT IN APF AND 
*                       SET SINGLE MODIFY AND SINGLE WRITE BITS 
*                       IN APF
*                IF MR, TURN OFF CONTROL,MODIFY,EXTEND  PERM
*                       IN FNT  AND  DO NOT SET ANY ACCESS
*                       BITS IN APF 
* 
          LDN    RWC               REWRITE KEYWORD CODE 
          RJM  EXFDB
          MJN  CAT10A 
          LDM    BUF+4
          SHN    -6 
          ADM    BUF+3
          ADM    BUF+2
          ADM    BUF+1
          ADM    BUF
          ZJN  CAT10A 
          LDM    PERM 
          SCN    10B
          STM    PERM 
          UJN  CAT10
* 
OLDAPF    LDN    CH.APF            DROP APF PSEUDO-CHANNEL
          RJM  R.DCH
          LDN    CODE15 
          RJM  ERR
* 
CAT10A    LDN    MRC               MULTI-READ KEYWORD CODE
          RJM  EXFDB
          MJN  CAT10
          LDM    BUF+4       CHECK MR VALUE FIELD 
          SHN    -6          REMOVE CODE FIELD
          ADM    BUF+3       CHECK ALL OF VALUE FIELD 
          ADM    BUF+2
          ADM    BUF+1
          ADM    BUF
          ZJN    CAT10       IF EXPLICIT MR=0 
          LDN    1
          STM    PERM 
CAT10     BSS    0
**
*         AL) STORE APF ORDINAL IN FNT
* 
          LDM    UFNT 
          STD    TEMP 
          ADN    W.FAPF            W.FAPF=WORD IN FNT WHICH CONTAINS
CAT10D    CRD    D.FNT                      APF POINTER OR LINK 
          LDD    D.FNT+C.FLINK
          SHN    17D-S.FLINK       CHECK LINK BIT 
          PJN  CAT10E              CHECK FOR LINKED FNT 
          LDD    D.FNT+C.FLNKAD 
          STD    TEMP 
          UJN  CAT10D 
CAT10E    LDM    APFO 
          STD    D.FNT+C.FAPF      WRITE APF PTR TO THE FNT 
          LDD    TEMP              ADDRESS OF FNT WORD WITH APF POINTER 
          CWD    D.FNT
          LDM    UFNT 
          ADN    2
          CRD    D.FNT
          LDD    D.FNT+C.FSC
          SCK    7400B
          STD    D.FNT+C.FSC
          LDM    PERM 
          SHN    8
          RAD    D.FNT+C.FSC
          LDM    UFNT 
          ADN    2
          CWD    D.FNT
* 
*         END OF NEWAPF 
* 
          RJM  APFADR 
          ADN    1
          CRD    D.FNT+5
          AOD    D.FNT+5+C.PFCNT
          RJM  APFADR 
          ADN    1
          CWD    D.FNT+5
          LDM    PERM 
          LPN    10B
          ZJN  CAT14
CAT12     LDD    D.FNT+5+C.PFLAG
          SCK    IBIT+EABIT 
          ADK    IBIT+EABIT 
          STD    D.FNT+5+C.PFLAG
CAT12A    LDD    D.FNT+5+C.PFLAG
          LPK    SBIT 
          NJN  CAT15
          LDM    PERM 
          LPN    2
          NJN  CAT16               DO NOT PUT FRBT IF GOT EXTEND PERM 
CAT15     LDM    UFNT 
          ADN    1
          CRD    D.T0 
          LDD    D.T0+C.FFRBA 
          STD    D.FNT+5+C.PFRBT
CAT16     RJM  APFADR 
          ADN    1
          CWD    D.FNT+5
          UJN  CAT13
* 
CAT14     LDM    PERM 
          LPN    6B 
          ZJN  CAT12A 
          LDN    RWC               REWRITE KEYWORD CODE 
          RJM  EXFDB               RW ABSENT OR EQUAL TO 0 MEANS
          MJN  CAT12A 
          LDM    PERM 
          IFEQ   IP.MREWR,0,1 
          LPN    MBIT+WBIT         SINGLE REWRITE 
          IFEQ   IP.MREWR,1,1 
          LPN    WBIT 
          RAD    D.FNT+5+C.PFLAG
          UJN  CAT12A 
* 
CAT13     LDN    0
          STM    RIL1A             SKIP CHECKING UTILITY BIT
          RJM  RPFM                GET PFM I/L
          ZJN  CAT13D 
          RJM  ERRFLG 
          ZJN  CAT13C 
          RJM  APFLAG 
          LCN    RC070
          RJM  ERR
* 
CAT13C    LDC    PFMDLY 
          RJM  DELAY
          UJN  CAT13
**
*         AM CALL 1FC TO CREATE PFC ENTRY.  LEAVE PASSWORDS IN
*            HIGH CORE FOR PFC ENTRY. 
* 
CAT13D    LDC    *-*               SET TO 1 WHEN PWS IN HIGH CORE 
PWFLG     EQU    *-1
  
          NJN  CAT13E              PASSWORDS ALREADY IN HIGH CORE 
          LDN    O.RDP
          RJM  IOPFD
          RJM  R.READP             READ PFD PRU 
          RJM  MOVEPWS             MOVE PASSWORDS INTO HIGH CORE
CAT13E    LDN    0
          STM    PFMI              CLEAR INTERNAL PFM I/L 
          LDC    OV.1FC 
          RJM  CALL 
* 
CHKPTR    EJECT  4,12 
**
*         CHKPER
* 
*         CHECKS IF USER HAS CONTROL PERMISSION/AND T/K.
* 
*         ENTRY  -ENTCOUNT HAS INDEX FOR ENTRY IN USE 
*         EXIT   -ACC=0 - YES   / = -1 - NO.
*         SUBROUTINES CALLED   CHKPW
* 
CHKPER    ENM    X
          LDM    SECT1+PWTK+4,ENTCOUNT
          ZJN  CHKPER1
          LDC    SECT1+PWTK 
          ADD    ENTCOUNT 
          RJM  CHKPW
          MJN  CHKPERX             IF NOT,ABORT 
* 
CHKPER1   LDM    SECT1+PWCNTL+4,ENTCOUNT
          ZJN  CHKPERX             IF NO CN, RETURN 
          LDC    SECT1+PWCNTL 
          ADD    ENTCOUNT 
          RJM  CHKPW
* 
          UJN  CHKPERX
WPFD      SPACE  4,12 
**        WPFD
*         ----
* 
*         SUBROUTINE TO WRITE A PFD ENTRY 
* 
*         ENTRY  PFD ENTRY IN SECT1 BUFFER
*                POINT CONTAINS PFD POINTER 
* 
*         EXIT   (A) = 0, NORMAL COMPLETION 
*                (A) =-1, SEARCH PFD AGAIN
* 
*         CALLS  WRTPFD, CHKSTS, READPFD
  
WPFD0     LCN    1                 RETURN TO SEARCH PFD 
  
WPFD      ENM    X                 ENTRY/EXIT 
  
WPFD1     RJM  WRTPFD              WRITE PFD ENTRY
          ZJN  WPFDX               IF ALRIGHT, EXIT 
* 
*         DEVICE I/L IS BROKEN
* 
WPFD2     RJM  READPFD             READ IN PFD ENTRY
          NJN  WPFD2               IF CONNECT BROKEN
* 
*         CHECK PFD ENTRY FREE/USE FLAG 
* 
          LDC    WPFD7
          STM    WPFD4A+1          RESTORE INSTRUCTION
          LDC    SECT1+4
          ADD    ENTCOUNT          ENTRY OFFSET 
          STD    D.Z7 
          LDI    D.Z7 
          LPN    EUFLAG 
          NJN  WPFD3               ENTRY IN USE 
          LJM  WPFD0               IF ENTRY FREE
* 
*         CHECK IF ANY CYCLES EXIST IN PFD
* 
WPFD3     LDN    0
          STD    TEMP 
          LDN    5
          STD    TEMP1
          LDC    SECT1+PCYNUM 
          ADD    ENTCOUNT 
          STD    TEMP2
WPFD4     LDI    TEMP2             GET CYCLE NUMBER 
          RAD    TEMP              SUM
          LDN    5
          RAD    TEMP2
          SOD    TEMP1             ALL 5 CYCLE SLOTS EXAMINED 
          NJN  WPFD4               NO 
          LDD    TEMP 
          ZJN  WPFD4B              IF NO CYCLES FOUND 
* 
WPFD4A    LJM  WPFD7               IF CYCLES FOUND
* 
*         SET THIS ENTRY TO FREE
* 
WPFD4B    LDI    D.Z7 
          SCN    EUFLAG 
          STI    D.Z7 
  
WPFD5     RJM  WRTPFD 
          ZJN  WPFD6               IF ALRIGHT 
          LJM  WPFD2               IF CONNECT BROKEN
  
WPFD6     LJM  WPFD0               EXIT 
  
WPFD7     LDC    *-*
CYSLOT    EQU    *-1
  
          ADC    SECT1
          STD    TEMP 
          STD    TEMP1
          LDI    TEMP              GET CYCLE NO.
          ZJN  WPFD6               IF NOT THERE 
          SBD    CYCLE
          NJN  WPFD6               IF CYCLE NOT MATCHED 
          AOD    TEMP 
          LDI    TEMP              GET MF ORDINAL 
          ZJN  WPFD6               IF NOT THERE 
          SBM    MFORD
          NJN  WPFD6               IF NOT COMPARED WITH HOST MF ORD 
  
          LDN    0
          STI    TEMP              CLEAR CYCLE NUMBER 
          STI    TEMP1             CLEAR MF ORDINAL 
          LDC    WPFD5
          STM    WPFD4A+1          * MODIFIED INSTRUCTION * 
          LJM  WPFD3
ISCYOK    SPACE  4,12 
**
*         ISCYOK
* 
*         CHECKS IF CYCLE NUMBER IS OK(GT.0 AND LT.1000D) 
* 
*         ENTRY - BUF-BUF+4=CYCLE WORD FROM FDB 
*         EXIT  - A=0 IF OK 
*                 CYCLE=CYCLE NUMBER IF OK
*                 A.LT.0 IF NO CY SPECIFIED 
*                 A.GT.0 IF CY BAD
* 
ISCYOK5   LDN    1
ISCYOK    ENM  X
          LDN    CYC               CYCLE NUMBER KEYWORD CODE
          RJM  EXFDB
          MJN  ISCYOKX
          LDM    BUF+4
          SHN    -6 
          STD    CYCLE
          LDM    BUF+3
          LPN    17B         CHECK 10 BITS(999D IS 1747B) 
          SHN    6
          RAD    CYCLE
          ZJN  ISCYOK5       EQ.0 
          ADC    -1000D 
          PJN  ISCYOK5       GT.999 
          LDM    BUF+3             ALL OTHER BITS SHOULD BE 0 
          SHN    -4 
          ADM    BUF+2
          ADM    BUF+1
          ADM    BUF
          UJK  ISCYOKX
  
**        END - COMPFC COMDECK
