*COMDECK,MMFCOM              MULTIMAINFRAME STAGING ROUTINES
 MMFCOM   CTEXT  MULTIMAINFRAME STAGING ROUTINES
  
  
***       MMFCOM COMMON DECK
* 
*         MULTIMAINFRAME PERMANENT FILE STAGING ROUTINES COMMON DECK
* 
*         THIS COMMON DECK CONTAINS CODE COMMON TO MULTI-MAINFRAME
*         ROUTINES WHICH WORK WITH THE ZZZZZPK FILE AND WHICH SWAP
*         JOBS TO THE  MULTI-MAINFRAME QUEUE. 
*         ROUTINES WHICH USE THIS COMMON DECK ARE SPF,GPF,PFP(1PG)
          SPACE  4
* 
*         COMMON MESSAGE AREA 
* 
  
  
 MSG      DIS    ,*        FILE NOT FOUND*
 MSG1     DIS    ,*FDB ADDRESS INVALID* 
 MSG2     DIS    ,*SN PARAMETER IGNORED*
 MSG3     DIS    ,*NO ST PARAMETER* 
 MSG4     DIS    ,*NO PFN OR LFN* 
 MSG5     DIS    ,*ILLEGAL LFN* 
 MSG6     DIS    ,*LFN NOT FOUND* 
 MSG7     DIS    ,*WAITING FOR MMF SAVEPF*
 MSG8     DIS    ,*RW PARAMETER IGNORED*
 MSG9     DIS    ,*ECS REQUEST IGNORED* 
 MSG10    DIS    ,*ILLEGAL SYSTEM CALL* 
 MSG11    DIS    ,*$DROP DIS,IF UP / N.UNLOCK*
 MSG13    DIS    ,*ILLEGAL DEVICE TYPE* 
 MSG14    DIS    ,*ILLEGAL ST PARAMETER*
 MSG15    DIS    ,*FILE NEVER ASSIGNED TO A DEVICE* 
 MSG16    DIS    ,*WAITING FOR MMF PURGE* 
 MSG17    DIS    ,*LFN ALREADY IN USE*
* 
* 
*         AC= DEFAULT VALUE 
* 
 ACDV     DATA   0,0,H*RLINKN*
          SPACE  4
 ADRFDB   TITLE  ADRFDB - CALCULATE FDB ADDRESS 
**
*         ADRFDB - SUBROUTINE TO CALCULATE FDB ABSOLUTE ADDRESS 
* 
*         ENTRY  - FDB ADDRESS CONTAINED IN PPIRB+3,PPIRB+4 
*                (A) CONTAINS OFFSET INTO FDB, POSITIVE OR NEG ALLOWED, 
*                BUT MUST BE GREATER THAN -77B. 
* 
*         EXIT   - ACCUM HAS ABSOLUTE FDB ADDRESS 
* 
*         USES   - NONE 
* 
*         CALLS  - R.TFL
*                  R.DFM
*                  R.MTR
* 
          SPACE  4
 ADRFDB   ENM    X                 CALCULATE FDB ADDRESS + 4
          ADN    77B               ASSURE POSITIVE
          SHN    6
          LMD    D.PPIRB+3
          SCN    37B
          LMD    D.PPIRB+3         INSERT ADDR, UPPER PORTION IN BITS0-5
          SHN    12 
          ADD    D.PPIRB+4
          SBN    77B               RESTORE TO ORIGINAL
          ADDRA  OK=ADRFDBX 
          LDC    MSG1              *FDB ADDRESS INVALID*
          UJK  GOAWAY2             ABORT
* 
          SPACE  4
 CKLI     TITLE  CHECK FOR DIS OR LOCKIN
**
*         CKLI - CHECK FOR NO JDT (DIS CONTROL POINT) OR FOR JOB BEING
*                LOCKED IN. 
* 
*         ENTRY  - NONE 
* 
*         EXIT   - NORMAL EXIT IF JOB NOT LOCKED IN OR NOT UNDER DIS. 
*                IF EXIT IS NORMAL THEN PFL+JDTNO WILL CONTAIN THE
*                VALID JDT ORDINAL. 
*                IF DIS CONTROL POINT THEN ABORT. 
*                IF JOB IS LOCKED IN THEN ISSUE UNLOCK MESSAGE AND
*                RESTART PP PROGRAM.
* 
*         USES   - LOCKIN 
*                - D.T0-D.T7
*                - D.Z1-D.Z7
*                - PFL+JDTNO
*                - JDTAD-JDTAD+1
* 
*         CALLS  - GOAWAY2
*                - GOAWAY1
* 
          SPACE  4
 JDNS     EQU    S.JDNS+12*C.JDOPF-48 
 JDTAD    BSSZ   2                 JDT ADDRESS
 LOCKIN   BSS    1
 QPRILI   EQU    7002B             QUEUE PRIORITY OF A LOCKED IN JOB
 SPDEV27  EQU    2700B             SPECIAL DEV TYPE USED FOR PACKET FNT 
  
  
 CKLI     ENM    X                 ENTRY/EXIT 
          LDD    D.CPAD 
          ADK    W.CPJNAM 
          CRD    D.T0 
          LDD    D.T4 
          SBM    NCP
          PJN  CKLI1               IF JDT NUMBER IS .GT. NO. OF C.P.
 CKLI0    LDC    MSG10             *ILLEGAL SYSTEM CALL*
          LJM  GOAWAY2
* 
 CKLI1    LDD    D.T4 
          STM    PFL+JDTNO
          LDN    0
          STM    LOCKIN 
          LDD    D.CPAD 
          ADK    W.CPSCH
          CRD    D.T0 
          LDD    D.T0+C.CPJDA 
          LPN    77B
          STM    JDTAD
          SHN    12 
          ADD    D.T0+C.CPJDA+1 
          STM    JDTAD+1
          ZJN  CKLI0               IF NO JDT NUMBER 
          ADK    W.JDDSD
          CRD    D.T0              READ IN WORD W.JDDSD OF JDT
          LDD    D.T0+C.JDOPF 
          LPN    S.JDNS 
          ZJN  CKLI2               IF JOB NOT LOCKED IN 
          LDN    1
          STM    LOCKIN 
* 
*         CHECK FOR LOCKIN
* 
 CKLI2    LDD    D.CPAD 
          ADK    W.CPRO 
          CRD    D.T0 
          LDD    D.T0+C.CPJQP 
          ADC    -QPRILI           CHECK QUEUE PRIORITY FOR LOCKIN
          PJN  CKLI3               JUMP IF LOCKED IN
          UJN  CKLI4               IF NOT LOCKED IN 
* 
* 
*         ISSUE UNLOCK MESSAGE AND GO INTO EVENT STACK
* 
 CKLI3    LDC    MSG11             *DROP DIS IF UP/ N.UNLOCK* 
          RJM  R.DFM
* 
          LDD    D.PPIR 
          ADK    W.PPMES1 
          CWD    D.PPIRB
          LDN    P.ZERO 
          CRD    D.T0 
          LDM    JDTAD
          STD    D.T1 
          LDM    JDTAD+1
          ADK    W.JDDSD
          STD    D.T2 
          LDC    F.ESOFF+F.ESABS+C.JDOPF*100B+JDNS
          STD    D.T4 
          LDN    M.EESD 
          LJM  GOAWAY1
* 
 CKLI4    LDN    2                 COUNTER FOR PP 
          STD    D.T7 
          LDN    P.NPP             POINTER OF NO OF PP
          CRD    D.T0              READ NO OF PP
          LDD    D.T0+C.NPP        NO OF PPS
          ADN    1
          STD    D.T5              SAVE NO OF PP+1
          LDN    P.PCOM            POINTER OF PP1 COMMUNICATION 
          CRD    D.T0 
          LDD    D.T0+C.PCOM       ADDR OF COMM. AREA OF PP1
          ADN    10B
          STD    D.Z6              SAVE NEXT PP ADDR OF COMM. 
 CKLI5    CRD    D.Z1              READ INPUT REGISTER
          LDD    D.Z1+C.CPNUM      GET CONTROL PT NO
          LPN    L.CPNUM
          LMM    CP                COMPARE CP NO. 
          ZJN  CKLI6               IF THE SAME CONTROL POINT
          UJN  CKLI7               GO CHECK NEXT PP 
* 
 CKLI6    LDD    D.Z1              GET 1ST TWO CHARACTERS 
          LMC    2RDI              COMPARE *DI* 
          NJN  CKLI7               IF PP NAME IS NOT *DIS*
          LDD    D.Z1+C.CPNUM      GET 3RD CHAR.
          SCN    77B
          LMC    1RS*100B          COMPARE *S*
          NJN  CKLI7               IF PP NAME IS NOT *DIS*
          LDC    MSG10             *ILLEGAL SYSTEM CALL*
          LJM  GOAWAY2             ABORT
* 
 CKLI7    AOD    D.T7              INCREMENT PP COUNT 
          SBD    D.T5              NO OF PPS+1
          PJN  CKLI8               IF ALL PPS HAVE BEEN CHECKED FOR DIS 
          LDN    10B
          RAD    D.Z6              INCRE. PP COMM.ADDR
          UJK  CKLI5
* 
 CKLI8    LDM    LOCKIN 
          ZJN  CKLI9               IF JOB NOT LOCKED IN 
          UJK  CKLI3               GO INTO EVENT STACK
* 
 CKLI9    UJK  CKLIX               RETURN 
* 
          SPACE  4
 CK4ZPK   TITLE  CHECK FOR ZZZZZPK FNT
**
*         CK4ZPK - CHECK FOR ZZZZZPK FNT
*         CREATE ZZZZZPK FILE IF NONE EXISTS FOR THIS CONTROL POINT.
*         CHECK TO BE SURE ZZZZZPK FNT IS SET COMPLETE. IF NOT GO INTO
*         THE DELAY STACK.
*         STORE LFN AND PFN IN THE PERMANENT FILE PACKET. 
*         DETERMINE PACKET PRIORITY 
*         STORE 3 CHARACTER LID (ST) IN PACKET. 
* 
*         ENTRY  -
*                - BUF+STPAR-BUF+STPAR+1 HAS 3 CHARACTER LID (ST) 
* 
*         EXIT   -
*                - PROPER PACKET FIELDS SET UP (PFL)
* 
*         USES   -
*                - TEMP 
*                - D.T0-D.T4
*                - D.Z1-D.Z5
* 
*         CALLS  -
*                - ZPK
*                - R.DCH
*                - EDSK      (LJM)
*                - GOAWAY2   (LJM)
* 
          SPACE  4
 TCB      BSSZ   1                 THIS DAM ORDINAL AND CURRENT BYTE
*                                  TCB IS THE VALUE OBTAINED BEFORE THE 
*                                  DISK WRITE OF THE PACKET IS DONE 
 NPRU     BSS    1                 THE NEXT PRU TO BE WRITTEN. NPRU IS
*                                  THE VALUE OBTAINED BEFORE THE WRITE
*                                  OF THE DISK PACKET IS DONE 
  
  
 CK4ZPK   ENM    X                 ENTRY/EXIT 
* 
*         CHECK FOR ILLEGAL ST PARAMETER
* 
          LDM    BUF+STPAR-1
          NJN  CK4Z1               IF ILLEGAL ST
          LDM    BUF+STPAR
          SHN    -6 
          NJN CK4Z2                IF ST O.K. 
 CK4Z1    LDC    MSG14             *ILLEGAL ST PARAMETER* 
          UJK  GOAWAY2             ABORT
* 
* 
*         SAVE ST PARAMETER 
* 
 CK4Z2    LDM    BUF+STPAR
          STM    PFL+STNID         SAVE STATION ID
          LDM    BUF+STPAR1 
          SCN    77B
          STM    PFL+STNID1        SAVE STATION ID
          LDN    0
          RJM  ZPK                 SEARCH EMPTY FNT ADDR OR ZZZZZPK 
* 
          LDM    ZFNT 
          ZJN  CK4Z3               JP, GO CREATE ZZZZZPK FNT
* 
*         ZZZZZPK EXIST, CHECK FOR BUSY BIT 
* 
          ADN    1
          CRD    D.T0              FST(1) OF ZZZZZPK
          ADN    1
          CRD    D.Z1              FST(2) 
          LDD    D.T0+C.FLPRU 
          STM    NPRU 
          LDD    D.T0+C.FCB 
          STM    TCB
          LDD    D.Z5 
          SHN    17 
          MJN  CK4Z4               JP, NOT BUSY 
          LDN    CH.FNT 
          RJM  R.DCH
* 
          UJK  EDSK                ENTER DELAY STACK, COMPLETE BIT ZERO 
* 
* 
*         CREATE ZZZZZPK FNT
* 
 CK4Z3    LDD    D.CPAD 
          SHN    -7 
          RAM    ZF+C.FCPNUM       ADD CONTROL PT NO. 
          LDN    P.MST             GET SYSTEM SET MST ORDINAL 
          CRD    D.T0 
          LDD    D.T0+C.DSMO
          SHN    -6 
          STM    SSMST             HOLD SYSTEM SET MST ORDINAL
          LDN    P.ZERO 
          CRD    D.T0 
          LDM    SSMST             GET SYSTEM SET MST ORDINAL 
          STD    D.T0+C.FEQP
          LDM    EFNT 
          CWM    ZF,D.PPONE        WRITE ZZZZZPK
          CWD    D.T0              SET UP FST(1) WITH MST ORDINAL 
 CK4Z4    LDN    O.WRP
          STD    D.Z5              SET BUSY BIT AND WRITE CODE
          LDN    0                 DISP CODE
          STD    D.Z3 
          LDM    ZFNT 
          ZJN  CK4Z5               JP, USE EMPTY SLOT FST(2) ADDR 
          ADN    1
          CWD    D.T0              WRITE FST(1) 
          ADN    1
          CWD    D.Z1              WRITE FST(2) 
          UJN  CK4Z6
* 
 CK4Z5    LDM    EFNT              GET EMPTY FNT ADDRESS
          ADN    2
          CWD    D.Z1              WRITE FST(2) 
 CK4Z6    LDN    CH.FNT 
          RJM  R.DCH
* 
* 
*         STORE PFN AND LFN IN PERMANENT FILE PACKET
* 
          LDN    4
          STD    TEMP 
          LCN    4
          RJM  ADRFDB 
          CRM    PFL+PFNBUF,TEMP     PFN
          CRM    PFL+LFNBUF,D.PPONE  LFN
* 
*         SET PRIORITY IN PERMANENT FILE PACKET 
* 
          LDM    JDTAD
          SHN    12 
          ADM    JDTAD+1
          ZJN  CK4Z7               JP, SYSTEM NO PRIORITY 
          ADK    W.JDMGR
          CRD    D.Z1 
          LDD    D.Z1+C.JDBP       BASE PRIORITY
          STM    PFL+PKTPRI        SAVE PACKET PRIORITY 
 CK4Z7    UJK  CK4ZPKX             EXIT 
* 
          SPACE  4
 CLFNT    TITLE  CREATE LOCAL PACKET FNT IMAGE
**
*         CLFNT - CREATE LOCAL PACKET FNT IMAGE 
* 
*         ENTRY  -
*                - (A) = PACKET TYPE 1=ATTACH, 2=CATALOG, 3=PURGE 
*                - STK1+1 = FST(1) ADDRESS OF ZZZZZPK FILE
* 
*         EXIT   -
* 
*         USES   -
*                - D.T0-D.T5
*                - D.Z1-D.Z4
* 
*         CALLS  -
* 
          SPACE  4
 CLFNT    ENM    X                 ENTRY/EXIT 
* 
*         CREATE LOCAL FILE FNT WITH SPECIAL DEV. TYPE
* 
          STD    D.T5              SAVE PACKET TYPE 
          LDN    P.ZERO 
          CRD    D.T0 
          CRD    D.Z1 
          LDD    D.T5              GET PACKET TYPE
          SHN    S.FPKTYP          SET PACKET TYPE
          SHN    18-S.FNRRBT
          ADN    1
          SHN    S.FNRRBT 
          STD    D.T0+C.FPKTYP
          LDN    1
          STD    D.T4 
* 
*         SET UP FST(1) IMAGE WITH SPECIAL DEVICE TYPE (27) 
* 
          LDM    STK1+1            FST(1) ADDR OF ZZZZZPK 
          CRD    D.Z1 
          LDD    D.Z1 
          LPN    77B
          ADC    SPDEV27           SPECIAL DEV TYPE FOR PACKET FNTS 
          STD    D.Z1 
          LDM    TCB               DETERMINE IF RB BOUNDARY CROSSED 
          ZJN  CLFNT1              IF VERY 1ST PACKET WRITTEN TO ZZZZZPK
          LMD    D.Z1+C.FCB 
          ZJN  CLFNT2              IF NO RB BOUNDARY CROSSED
 CLFNT1   SOD    D.Z1+C.FLPRU      GET ACTUAL PRU WRITTEN 
          UJN  CLFNT3 
 CLFNT2   LDM    NPRU 
          STD    D.Z1+C.FLPRU 
 CLFNT3   UJK  CLFNTX              EXIT 
* 
          SPACE  4
 DLAY     TITLE  DLAY, WAIT WITHIN A PP 
**
*         DLAY - WAIT FOR A PERIOD OF TIME WITHIN THE PP
* 
*         ENTRY  - ACCUM CONTAINS DELAY TIME N
* 
*         EXIT   - AFTER 1/4 MSEC DELAY EXECUTED N TIMES
* 
*         USES   - TEMP 
* 
*         CALLS  - ERO
*                  R.RAFL 
* 
          SPACE  4
 DLAY     ENM    X
          STD    TEMP 
 DLAY10   LDC    125D              1/4 MSEC DELAY 
          SBN    1
          NJN  *-1
          SOD    TEMP              REPEAT N TIME
          NJN  DLAY10 
          RJM  ERO
* 
          RJM  R.RAFL 
* 
          UJK  DLAYX
* 
          SPACE  4
 EDSK     TITLE  EDSK - ENTER PP INTO DELAY STACK (PJT) 
**
*         EDSK - ENTER PP INTO DELAY STACK (PJT)
* 
*         ENTRY  - NONE 
* 
*         EXIT   - NONE 
* 
*         USES   - D.T0-D.T4
* 
*         CALLS  - R.MTR
* 
          SPACE  4
 EDSK     LDN    P.ZERO            ZERP W.PPMES4-W.PPMES6 
          CRD    D.T0 
          LDD    D.PPIR 
          ADK    W.PPMES4 
          CWD    D.T0 
          ADN    1
          CWD    D.T0 
          ADN    1
          CWD    D.T0 
          LDD    D.PPMES1 
          CWD    D.PPIRB
          LDC    4*500             500 MILLISECOND RECALL 
          STD    D.T2 
          LDN    M.RPJ
          RJM  R.MTR
* 
          UJN  GOAWAY              DROP PP
* 
          SPACE  4
 ERO      TITLE  ERO - CHECK ERROR FLAG 
**
*         ERO - CHECK ERROR FLAG AT CONTROL POINT 
* 
*         ENTRY  - NONE 
* 
*         EXIT   - NONE 
*         USES   - D.T0-D.T4
* 
*         CALLS  - R.MTR
* 
          SPACE  4
ERO       ENM    X
          LDD    D.CPAD 
          ADK    W.CPEF 
          CRD    D.T0 
          LDD    D.T0+C.CPEF
          NJN  *+2
          UJN  EROX 
* 
          UJN  GOAWAY              DROP PP
* 
          SPACE  4
 GOAWAY   TITLE  DROP PP AND GO AWAY
**
*         GOAWAY - DROP PP AND GO AWAY.  ISSUE DAYFILE MESSAGE IF 
*                REQUIRED AND ABORT JOB IF REQUIRED.
* 
*         ENTRY  - (A) = ADDRESS OF DAYFILE MESSAGE (IF ANY)
* 
*         EXIT   - NONE 
* 
*         USES   - NONE 
* 
*         CALLS  - R.MTR
*                - R.DFM
* 
          SPACE  4
 GOAWAY   LDN    M.DPP
 GOAWAY1  RJM  R.MTR
* 
          LJM  R.IDLE 
* 
 GOAWAY2  RJM  R.DFM
          LDN    M.ABORT
          UJK  GOAWAY1
* 
          SPACE  4
 SETUP    TITLE  SETUP PP CELLS 
**
*         SETUP - SETUP CERTAIN PP CELLS FOR LATER USE
* 
*         ENTRY  - NONE 
* 
*         EXIT   - D.PPONE = 1
*                - CP = CONTROL POINT NUMBER
*                - NCP = NUMBER OF CONTROL POINTS + 1 
* 
*         USES   - D.PPONE
*                - CP 
*                - NCP
*                - D.T0+D.T4
* 
*         CALLS  - NONE 
* 
          SPACE  4
 NCP      BSS    1                 NUMBER OF CONTROL POINTS + 1 
  
  
 SETUP    ENM    X                 ENTRY/EXIT 
          LDN    1
          STD    D.PPONE
          LDD    D.PPIRB+1
          LPN    L.CPNUM
          STM    CP                CONTROL POINT NO.
          LDN    P.NCP
          CRD    D.T0 
          LDD    D.T4 
          ADN    1
          STM    NCP               NO OF CONTROL PTS + 1
          UJK  SETUPX              EXIT 
* 
          SPACE  4
 SMMF     TITLE  SMMF - SWAP TO MMF QUEUE 
**
*         SMMF - ATTEMPT TO SET UP TO SWAP/ROLL A JOB TO THE MMF QUEUE
* 
*         ENTRY  - ZZZZZPK FILE BUSY (NOT COMPLETE) 
*                  FNT CHANNEL ALREADY RESERVED 
* 
*         EXIT   - RETURN IF SUCCESSFUL IN SETTING UP FOR SWAP TO THE 
*                   MMF QUEUE.  OTHERWISE, PUT THE PP INTO THE
*                   PERIPHERAL JOB STACK TO RECALL IT AFTER SETTING 
*                   THE COMPLETE BIT FOR THE ZZZZZPK FILE 
* 
*         USES   - D.T0-D.T4
*                  D.T6 
*                  D.Z1-D.Z5
* 
*         CALLS  - C1SO 
*                  SZPKC
* 
          SPACE  4
 STAT     EQU    D.T0 
 NOSWAP   EQU    D.T6 
  
  
 SMMF     ENM    X                 ENTRY/EXIT 
* 
*         SET UP PP MESSAGE BUFFER FOR REENTRY
*         SET 77 IN BYTE 4 OF W.PPMES6
* 
          LDD    D.PPIR 
          ADK    W.PPMES6 
          CRD    D.T0 
          LDD    D.T4 
          SCN    77B
          ADN    77B
          STD    D.T4 
          LDD    D.PPIR 
          ADK    W.PPMES6 
          CWD    D.T0 
          LDN    F.JDWMM           MMF QUEUE
          STD    STAT 
          LDN    P.ZERO 
          CRD    D.Z1              ZERO D.Z1-D.Z5 
          LDD    D.PPIR 
          ADN    W.PPMES4 
          CWD    D.Z1              SET UP TO REENTER PP ROUTINE 
          LDC    SMMF1
          STD    NOSWAP            SET UP RETURN ADDRESS IF NO SWAP 
          C1SO   STAT,IRIMAGE,,,NOSWAP,CTLBACK
          UJK  SMMFX               RETURN IF SWAP IS SET UP 
* 
*         IF SWAPOUT NOT POSSIBLE (1SO ALREADY CALLED) THEN SET 
*         THE ZZZZZPK FILE COMPLETE BIT  AND EXIT 
* 
 SMMF1    RJM  SZPKC               SET ZZZZZPK FILE COMPLETE
* 
* 
*         CLEAR PP REENTRY FLAG 
* 
          LDD    D.PPIR 
          ADK    W.PPMES6 
          CRD    D.T0 
          LDD    D.T4 
          SCN    77B
          STD    D.T4 
          LDD    D.PPIR 
          ADK    W.PPMES6 
          CWD    D.T0 
          UJK  EDSK                PUT PP IN DELAY STACK
* 
          SPACE  4
 SZPKC    TITLE  SZPKC - SET ZZZZZPK FILE COMPLETE
**
*         SZPKC  - SET ZZZZZPK FILE COMPLETE BIT
* 
*         ENTRY  - (ZFNT) = FNT ADDRESS OF ZZZZZPK FILE 
*                  FNT CHANNEL ALREADY RESERVED 
* 
*         EXIT   - ZZZZZPK COMPLETE BIT IS SET
*                  FNT CHANNEL NOT RESERVED 
* 
*         USES   - D.T0-D.T4
* 
*         CALLS  - R.DCH
* 
          SPACE  4
 SZPKC    ENM    X                 ENTRY/EXIT 
          LDM    ZFNT 
          ADN    W.FNT3 
          CRD    D.T0 
          LDD    D.T0+C.FCS+1 
          SCN    1
          ADN    1                 SET COMPLETE BIT 
          STD    D.T0+C.FCS+1 
          LDM    ZFNT 
          ADN    W.FNT3 
          CWD    D.T0 
          LDN    CH.FNT 
          RJM  R.DCH               DROP THE FNT CHANNEL 
* 
          UJK  SZPKCX              RETURN 
* 
          SPACE  4
 XFDB     TITLE  XFDB - EXTRACT FDB PARAMETER 
**
*         XFDB - EXTRACT PARAMETER OF A GIVEN FDB VALUE FROM
*                THE CENTRAL MEMORY FDB LIST. 
* 
*         ENTRY  - VALUE IN ACCUM 
* 
*         EXIT   - ACCUM NEGATIVE IF PARAMETER NOT FOUND
*                - ACCUM ELSE(POSITION FOUND) AND PARAMETER IN BUF
* 
*         USES   - SCRATCH
*                - TEMP 
*                - BUF-BUF+4
* 
*         CALLS  - ADRFDB 
* 
          SPACE  4
 XFDBR    LCN    1
 XFDB     ENM    X
          STD    SCRATCH
          LDN    1
          STD    TEMP 
*                                  (A=TEMP= THE OFFSET) 
 XFDB10   RJM  ADRFDB 
          CRM    BUF,D.PPONE
          LDM    BUF+4
          ZJN  XFDBR
          LPN    77B               GET NUMERIC CODE 
          SBD    SCRATCH           CHECK VALUE
          ZJN  XFDB20 
          AOD    TEMP 
          UJK  XFDB10              LOOP 
* 
 XFDB20   LDD    TEMP 
          UJK  XFDBX               RETURN 
* 
          SPACE  4
 ZPK      TITLE  ZPK - FIND ZZZZZPK AND EMPTY FNT SLOT
**
*         ZPK - SEARCH THE FNT FOR THE PROPER ZZZZZPK FILE
*                (OR IN SOME CASES SOME OTHER SPECIFIED FILE) 
*                AND ALSO FIND AN UNUSED FNT ENTRY
* 
*         INSTRUCTION MODIFICATION IS MADE IN THIS SUBROUTINE WHEN
*         A SEARCH OF THE FNT IS REQUIRED FOR A FILENAME OTHER THAN 
*         ZZZZZPK.
* 
*         ENTRY  (A) = 0, NORMAL FNT SEARCH 
*                    OR 
*                (A) = 5 AND (D.Z1) IS THE ADDRESS OF FNT 
*                      THE ROUTINE WILL START SEARCH AT THE 
*                      ADDRESS OF FNT(D.Z1).
*                CP - MUST CONTAIN CONTROL POINT NUMBER 
* 
*         EXIT
*                UFNT = FNT ADDR OF EMPTY SLOT
* 
*                ZFNT = 0, NO ZZZZZPK FILE. 
*                     " 0, CONTAIN ZZZZZPK  FNT ADDR. 
*                FNT CHANNEL IS RESERVED
* 
*         USES   - D.T0-D.T4
*                - D.Z4 
*                - ZFNT 
*                - EFNT 
*                - FLG
* 
*         CALLS  - DLAY 
*                - R.DCH
* 
          SPACE  4
 CP       BSSZ   1                 CONTROL POINT NUMBER 
 EFNT     BSSZ   1                 EMPTY FNT SLOT ADDRESS 
 FLG      BSSZ   1                 IF " 0, ZZZZZPK FNT ADDRESS HAS
*                                  BEEN FOUND 
 ZFNT     BSSZ   1                 ZZZZZPK FILE FNT ADDRESS 
  
  
 ZPK      ENM    X
          STD    D.Z4 
          LDN    0
          STM    FLG
 ZPK1     LDN    CH.FNT            RESERVE FNT CHANNEL
          RJM  R.RCH
* 
          LDD    D.Z1 
          STD    D.T0+C.FNT 
          LDD    D.Z4 
          SBN    5
          ZJN  ZPK3 
          LDN    P.FNT
          CRD    D.T0              ADDR OF FNT PTR WORD 
          LDN    0
 ZPK2     STM    ZFNT              *MAY BE MODIFIED*
          STM    EFNT 
 ZPK3     LDD    D.T0+C.FNT 
          CRD    D.Z1              READ FNT ENTRY 
          LDD    D.Z1              FNT
          NJN  ZPK5                NOT EMPTY FNT, JP
          LDD    D.T0 
          STM    EFNT              STORE EMPTY FNT ADDR 
 ZPK4     LDM    ZFNT              *MAY BE MODIFIED*
          NJN  ZPKX 
          LJM  ZPK13               GO TO NEXT FNT SLOT
* 
*         CHECK FOR ZZZZZPK (OR OTHER) FILENAME 
 ZPK5     LMC    2RZZ              *MAY BE MODIFIED*
          NJN  ZPK9 
          LDD    D.Z2 
 ZPK6     LMC    2RZZ              *MAY BE MODIFIED*
          NJN  ZPK9 
          LDD    D.Z3 
 ZPK7     LMC    2RZP              *MAY BE MODIFIED*
          NJN  ZPK9 
          LDD    D.Z4 
          SCN    77B
 ZPK8     LMC    1RK*100B          *MAY BE MODIFIED*
          NJN  ZPK13
          LDD    D.Z4 
          LPN    17B
          SBM    CP 
          ZJN  ZPK10               IF CORRECT CONTROL POINT NUMBER
          UJN  ZPK12
* 
 ZPK9     UJN  ZPK13
* 
* 
*         ZZZZZPK OR SEARCH FILE FOUND
* 
 ZPK10    LDD    D.T0 
 ZPK11    STM    ZFNT              *MAY BE MODIFIED*
          LDN    1
          STM    FLG
 ZPK12    LDM    FLG
          ZJN  ZPK13
          LDM    EFNT 
          NJN  ZPK15
 ZPK13    LDN    LE.FNT 
          RAD    D.T0              NEXT FNT ADDR
          SBD    D.T1              LWA+1 OF FNT 
          PJN  ZPK14
          UJK  ZPK3 
* 
* 
*         END OF FNT TABLE
* 
 ZPK14    LDM    EFNT              EMPTY SLOT FOR FNT 
          NJN  ZPK15
          LDN    CH.FNT 
          RJM  R.DCH               DELAY, NO EMPTY SLOT 
* 
          LDN    4
          RJM  DLAY 
* 
          LJM  ZPK1 
* 
 ZPK15    LJM  ZPKX                EXIT 
* 
 MMFCOM   ENDX
