*COMDECK  PFCD03
          CTEXT  PFCD03 - SET PFM ROUTINES
          SPACE  2
*         DUE TO SPACE LIMITATIONS IN THE PERMANENT FILE
*         MANAGER THE SUBROUTINES IN PFCD03 ARE ASSEMBLED 
*         ONLY WHEN NECESSARY. THE ASSEMBLY IS CONTROLED
*         BY THE FOLLOWING SYMBOL DEFINITIONS.
          SPACE  2
*         *AFMT*     ASSEMBLE SUBROUTINE FMT
*         *LPFFMT*   OMIT A PORTION OF FMT FOR LPF
*         *DFINDMST* DON-T ASSEMBLE SUBROUTINE FINDMST
*         *DMSTADR*  DON-T ASSEMBLE SUBROUTINE MSTADR 
*         *DPSDFNT*  DON-T ASSEMBLE SUBROUTINE PSDFNT 
*         *DSDENTRY* DON-T ASSEMBLE SUBROUTINE SDENTRY
FMT       SPACE  4,10 
AFMT      IF     DEF,AFMT 
FMT       TITLE  FMT - FIND MST ORDINAL 
**
*         FMT 
* 
*                FIND MST ORDINAL (FROM SET FNT)
* 
*         ENTRY  *LPF* (BUF,BUF+4)=SETNAME
*                *PFA* SETNAME IN FDB 
* 
*         EXIT   (MSTORD)=MST ORDINAL 
* 
*         CALLS  SRCHCP,EXFDB 
* 
*         USES   NONE 
  
  
FMT5      BSS    0
SYS       IF     DEF,ATTACH 
*         IF ID=SYSTEM, MSTORD = SYSTEM SET 
          LDC    SYSTEM 
          STD    TEMP1
          LDC    OWNER
          STD    TEMP2
          RJM  COMPARE
          NJN  FMT5A
          LDK    P.DSMO 
          CRD    D.Z1 
          LDD    D.Z1+C.DSMO
          SHN    -6                MSTORD OF SYSTEM SET 
          UJN  FMT7 
  
FMT5A     BSS    0
SYS       ENDIF 
          LDD    D.CPAD      SEE IF CTL POINT ZERO... 
          NJN    FMT6A       IF NOT CONTROL POINT ZERO
          LDK    P.DSMO 
          CRD    D.Z1 
          LDD    D.Z1+C.DSMO
          LPN    77B
          UJN    FMT7 
  
 FMT6A    LDD    D.CPAD 
          ADK    W.CPDSMO 
          CRD    D.Z1 
          LDD    D.Z1+C.CPDSMO     DEFAULT SET MST ORDINAL
 FMT7     STM    MSTORD      SAVE MST ORD 
  
 FMT      ENM    X
  
          IF     -DEF,LPFFMT,4
          LDN    SNC               SETNAME KEYWORD CODE 
          RJM    EXFDB       LOOK FOR SN
          PJN  FMT1 
          LJM  FMT5 
  
FMT1      BSS    0
          LDN    0
          STM    BUF+4       CLEAR CODE 
          LDM    BUF
  
          IF     -DEF,LPFFMT,2
          ZJN    FMT4        IF NO SETNAME
          SKIP   1
          ZJN  FMT6A
  
          LDC    4000B
          RAM    BUF
          LDC    BUF
          RJM    SRCHCP      FOUND FNT FOR SET AT THIS CP 
          ZJN    FMT6        IF FOUND 
  
          LDD    D.T2        CHECK IF EXISTS AT C. P. ZERO
          NJN  FMT3 
  
          LCN    RC041       SET NOT MOUNTED
          UJN  FMT4A
  
 FMT4     LCN    RC040       ILLEGAL SETNAME
FMT4A     RJM  ERR
  
 FMT3     CRD    D.FNT
  
 FMT6     LDD    D.FNT+C.FMST     GET MST ORD 
          UJK    FMT7        EXIT 
AFMT      ENDIF 
FINDMST   SPACE  4,10 
DFINDMST  IF     -DEF,DFINDMST
 FINDMST  TITLE  FINDMST - FIND MST ORDINAL 
**
*         FINDMST 
* 
*                FIND MST ORDINAL (IN LOCAL FNT)
* 
*         EXIT   (A)=0 IF FNT FOUNT 
*                (MSTORD)=MST ORDINAL 
*                (A)"0 IF FNT NOT FOUND 
* 
*         CALLS  SRCHCP 
* 
*         USES   D.FNT-D.FNT+9,MSTORD 
* 
  
          IF     -DEF,EXTEND,1
          IF     DEF,RENAME,1 
FINDMST   RMT 
 FINDMST1 LDD    D.T0 
          ADN    1
          CRD    D.FNT+5
          LDD    D.FNT+5
          LPN    77B
          STM    MSTORD 
          LDN    0
  
 FINDMST  ENM    X
          LDC    LFN
          RJM    SRCHCP 
          ZJN    FINDMST1    IF FOUND 
          UJK    FINDMSTX 
          IF     -DEF,EXTEND,1
          IF     DEF,RENAME,1 
FINDMST   RMT 
DFINDMST  ENDIF 
DMSTADR   IF     -DEF,DMSTADR 
 MSTADR   TITLE  MSTADR - LOAD MST ADDRESS
**
*         MSTADR
* 
*                LOAD MST ADDRESS 
* 
*         ENTRY- (MSTORD)=MST ORDINAL 
* 
*         EXIT-  (A)=MST ENTRY ADDRESS
* 
*         USES-  D.Z0-D.Z4
* 
 MSTADR   ENM    X
          LDK    P.MST
          CRD    D.Z0 
          LDD    D.Z0+C.MST 
          SHN    1
.1        SET    LE.MST/4 
          DUP    .1,1 
          ADM    MSTORD 
          SHN    2
.1        SET    LE.MST-.1*4
          DUP    .1,1 
          ADM    MSTORD 
          SBN    LE.MST 
          UJK    MSTADRX
  
DMSTADR   ENDIF 
PSDFNT    SPACE  4,10 
DPSDFNT   IF     -DEF,DPSDFNT 
 PSDFNT   TITLE  PSDFNT - BUILD PSEUDO FST
**
*         PSDFNT
* 
*                BUILD PSEUDO FST 
* 
*         ENTRY- SUB-DIRECTORY FST
*                   (A)=SUB-DIRECTORY NUMBER
* 
*                0RBTC+ FST 
*                   (A)=0 
*                   (SCRATCH)=0     ADD 0 TO 0RBTC
*                            "0     ADD CEOI TO 0RBTC 
* 
*         EXIT-  (D.FNT-D.FNT+9)=PSEUDO FST 
*                (TEMP2)=PRU OFFSET TO SD 
* 
*         CALLS - CALPTR,MSTADR 
* 
*         USES-  D.Z0-D.Z7,D.T0-D.T6,TEMP2,SCRATCH
* 
PSDFNT    IF     -DEF,CVPR..
 PSDFNT   ENM    X
          STD    D.Z6 
          ZJN    PSDFNT3
          LCN    1
 PSDFNT3  ADC    1700B+W.MSPFD-W.MSPFC *SBN 1*
          STM    PSDFNT2
          RJM    MSTADR 
          ADN    W.MSPFD
          CRD    D.Z0 
 PSDFNT2  SBN    *-*
          CRD    D.T1        (D.T1)=1ST RBT 
          LDD    D.T1 
          STM    PSDFNT7
          LDD    D.Z0+C.MSHPN 
          LPN    77B
          ADC    1000B       *SHN*
          STM    PSDFNT1
          LDD    D.Z6 
          NJN    PSDFNT5     IF SD NUMBER 
          LDD    SCRATCH
          ZJN    PSDFNT4     IF 0RBTC 
          LDD    D.T1+C.MSCEOI
          LPN    37B
          SHN    12 
          LMD    D.T1+C.MSCEOI+1
          UJN    PSDFNT4
 PSDFNT5  SBN    1
 PSDFNT1  SHN    *-*
 PSDFNT4  ADN    8           ADD PRU OFFSET 
          STD    TEMP2
          STD    D.T0 
          SHN    -12
          STD    D.Z7 
          LDN    0
CVPR.     SET    *
          RJM    /CALPTR/CALPTR 
          LDN    P.ZERO 
          CRD    D.FNT
          CRD    D.FNT+5
          RJM    MSTADR 
          ADN    W.MSPTR
          CRD    D.Z0 
          LDD    D.Z0+C.MSEQT 
          SHN    6
          ADM    MSTORD 
          STD    D.FNT+C.FEQP 
          LDC    *-*
 PSDFNT7  EQU    *-1
          STD    D.FNT+C.FFRBA
          LDM    RBTA 
          STD    D.FNT+C.FLRBWP 
          LDM    RBTO 
          STD    D.FNT+C.FCB
          LDM    PRU
          STD    D.FNT+C.FLPRU
          LDN    1
          STD    D.FNT+5+C.FCS+1   CODE AND STATUS
 PSDOUT   UJK    PSDFNTX
 PSDFNT   ELSE
  
 PSDFNT   ENM    X                 ENTRY / EXIT 
  
          STD    D.Z6 
          ZJN  PSDFNT1             BUILD PFC FNT ENTRY
          LDK    W.MSPFD-W.MSPFC
 PSDFNT1  ADC    1600B+W.MSPFC
          STM    PSDFNTA           ** MODIFY INSTRUCTION ** 
          RJM  MSTADR 
  
 PSDFNTA  ADN    *-*               ** INSTRUCTION MODIFIED ** 
  
          CRD    D.Z1 
          LDD    D.Z1+C.MSHPN 
          LPN    77B
          ADC    1000B             SHN INSTRUCTION
          STM    PSDFNTB           ** MODIFY INSTRUCTION ** 
          LDD    D.Z6 
          NJN  PSDFNT2             PFD
          LDD    SCRATCH
          ZJN  PSDFNT3             BOI+8 PRU PFC
          LDD    D.Z1+C.MSCEOI
          LPN    37B
          SHN    12 
          LMD    D.Z1+C.MSCEOI+1
          UJN  PSDFNT3
  
 PSDFNT2  SBN    1                 SD NUMBER - 1
  
 PSDFNTB  SHN    *-*               ** INSTRUCTION MODIFIED ** 
  
 PSDFNT3  ADN    8                 PREAMBLE OFFSET
          STD    TEMP2
          STD    D.T0+2 
          SHN    -12
          STD    D.T0+1 
          LDN    0
          STD    D.T0+3            USE FIRST WORD PAIR FORM OF EX.RBT 
          LDK    P.ZERO 
          CRD    D.FNT+5
          RJM  /CALPTR/CPR=        (A) = 0  FOR ABORT ON ERROR
          LDD    D.PPMES1 
          CRD    D.FNT
          LDN    1
          STD    D.FNT+5+C.FCS+1
          UJK  PSDFNTX
PSDFNT    ENDIF 
  
DPSDFNT   ENDIF 
          ENDX
