SSDEF 
PRGM SSDEF; 
  
  
# TITLE SSDEF - MAIN ROUTINE OF SSDEF.                                # 
  
      BEGIN  # SSDEF #
  
# 
***   SSDEF - INITIALIZE CATALOGS AND SMMAPS. 
* 
*     SSDEF ENSURES THAT CATALOGS AND SMMAPS ARE INITIALIZED. 
*     SSDEF MUST BE RUN FROM THE MAINFRAME WHICH HAS ACCESS TO ALL
*     FAMILIES THAT MAY CONTAIN *M860* FILES. 
* 
* 
*     SSDEF,PARAMETER,PARAMETER.
* 
*     PARAMETER     DESCRIPTION 
* 
*     SM            USE *SM* A. 
* 
*     SM=X          USE *SM* X WHEN X IS ONE OF THE FOLLOWING:  
*                   A - *SM* A
*                   B - *SM* B
*                   C - *SM* C
*                   D - *SM* D
*                   E - *SM* E
*                   F - *SM* F
*                   G - *SM* G
*                   H - *SM* H
* 
*     SM OMITTED    *FM* OPTION MUST BE SPECIFIED.
* 
*     FM            USE DEFAULT FAMILY. 
* 
*     FM=FAMILY     THE SPECIFIED FAMILY WILL BE USED.
* 
*     FM OMITTED    *SM* OPTION MUST BE SPECIFIED.
* 
*     NOTE: ONE *SM* AND/OR ONE *FM* PARAMETER MUST BE SPECIFIED
*           FOR EACH EXECUTION OF *SSDEF*.
* 
* 
*     PRGM SSDEF. 
* 
*     ENTRY.     PARAMETERS ARE IN THE *RA* AREA. 
* 
*     EXIT.      SSDEF COMPLETE.
*                ERROR CONDITION - ABORT WITH DAYFILE MESSAGE.
* 
*     MESSAGES.  SSDEF ABORT - SYNTAX ERROR.
*                SSDEF ABORT - NO PARAMETER SPECIFIED.
*                SSDEF - MUST BE SYSTEM ORIGIN. 
*                SSDEF ABORT - ILLEGAL SM VALUE.
*                SSDEF ERRORS.
*                SSDEF COMPLETE.
* 
*     COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
# 
  
# 
****  PRGM SSDEF - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ABORT;                  # CALLS *ABORT* MACRO #
        PROC DFCAT;                  # INITIALIZES SFMCATN FILES #
        PROC DFMAP;                  # INITIALIZES SMMAPN FILES # 
        PROC DFTAB;                  # SETS UP ARGUMENT LIST #
        PROC GETPFP;                 # GET USER INDEX AND FAMILY #
        PROC GETSPS;                 # GET SYSTEM ORIGIN STATUS # 
        PROC MESSAGE;                # CALLS MESSAGE MACRO #
        PROC RESTPFP;                # RESTORE USER-S *PFP* # 
        PROC SSINIT;                 # ACCESS ROUTINE INITIALIZER # 
        PROC XARG;                   # CRACK PARAMETER LIST # 
        END 
  
# 
****  PRGM SSDEF - XREF LIST END. 
# 
  
      DEF SMMAX      #"H"#;          # MAXIMUM SM VALUE # 
      DEF SMMIN      #"A"#;          # MINIMUM SM VALUE # 
      DEF NOPARAM    #-1#;           # NO PARAMETER SPECIFIED # 
      DEF RSLEN      #1#;            # RETURN STATUS WORD LENGTH #
      DEF SYNTAXOK   #0#;            # SYNTAX OK #
  
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS # 
  
                                               CONTROL PRESET;
*CALL COMBFAS 
*CALL COMBCMD 
*CALL COMBCMS 
*CALL COMBPFP 
*CALL COMTDEF 
*CALL COMTDFP 
  
      ITEM ARGLIST    U;             # ADDRESS OF ARGUMENT TABLE #
      ITEM FLAG       U;             # ERROR FLAG FOR ASARG # 
      ITEM OPTION     I;             # OPTION TO SKIP PROGRAM NAME #
  
      ARRAY SPSSTAT [0:0] S(1); 
        BEGIN 
        ITEM SPSSTATUS  U(00,48,12);  # RETURN STATUS # 
        END 
  
                                               CONTROL EJECT; 
  
# 
*     IF THE USER HAS SYSTEM ORIGIN PRIVELEDGES, THEN SAVE THE USER-S 
*     CURRENT PERMANENT FILE PARAMETERS.
# 
  
      GETSPS(SPSSTAT);               # GET SYSTEM ORIGIN STATUS # 
      IF SPSSTATUS NQ 0 
      THEN
        BEGIN 
        MSG$LINE[0] = " SSDEF - MUST BE SYSTEM ORIGIN.";
        MESSAGE(MSG$BUF[0],SYSUDF1);
        ABORT;
        END 
  
  
      GETPFP(PFP[0]); 
      USER$FAM[0] = PFP$FAM[0]; 
      USER$UI[0] = PFP$UI[0]; 
      USER$PACK[0] = PFP$PACK[0]; 
  
# 
*     CRACK THE PARAMETERS ON THE *SSDEF* CALL. 
# 
  
      DFTAB(ARGLIST);                # SET UP THE ARGUMENT LIST # 
      OPTION = 0;                    # SKIP OVER PROGRAM NAME # 
      XARG(ARGLIST,OPTION,FLAG);     # CRACK THE PARAMETERS # 
  
      IF FLAG NQ SYNTAXOK 
      THEN
        BEGIN 
        MSG$LINE[0] = " SSDEF ABORT - SYNTAX ERROR."; 
        MESSAGE(MSG$BUF[0],SYSUDF1);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT # 
        END 
  
# 
*     CHECK FOR INVALID PARAMETER OPTIONS.
# 
  
      IF(DARG$ISM EQ NOPARAM AND DARG$IFM EQ NOPARAM) 
      THEN
        BEGIN 
        MSG$LINE[0] = " SSDEF ABORT - NO PARAMETER SPECIFIED."; 
        MESSAGE(MSG$BUF[0],SYSUDF1);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT # 
        END 
  
      IF DARG$ISM NQ NOPARAM         ## 
        AND (DARG$IRSM LS SMMIN      ## 
        OR DARG$IRSM GR SMMAX        ## 
        OR DARG$IRSMR NQ 0) 
      THEN
        BEGIN 
        MSG$LINE[0] = " SSDEF ABORT - ILLEGAL SM VALUE."; 
        MESSAGE(MSG$BUF[0],SYSUDF1);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT # 
        END 
  
# 
*     CALL INITIALIZATION ROUTINE FOR CATALOG AND MAP ACCESS ROUTINES.
# 
  
      SSINIT;                        # INITIALIZES ACCESS ROUTINES #
  
# 
*     PROCESS PARAMETERS. 
# 
  
  
      IF(DARG$IFM NQ NOPARAM) 
      THEN
        BEGIN  # FM PARAMETER SPECIFIED # 
        DFCAT;                       # INITIALIZE SFMCAT FILES #
        END 
  
      IF(DARG$ISM NQ NOPARAM) 
      THEN
        BEGIN  # SM PARAMETER SPECIFIED # 
        DFMAP;                       # INITIALIZE SMMAP # 
        END 
  
# 
*     CHECK ERROR FLAG FOR SSDEF ERRORS.
# 
  
      IF ERRFLAGDF OR ERRFAMDF
      THEN
        BEGIN 
        MSG$LINE[0] = " SSDEF ERRORS."; 
        MESSAGE(MSG$BUF[0],SYSUDF1);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT # 
        END 
  
      ELSE
        BEGIN 
        MSG$LINE[0] = " SSDEF COMPLETE.";  # SSDEF COMPLETE # 
        MESSAGE(MSG$BUF[0],UDFL1);
        END 
  
      RESTPFP(PFP$END);              # RESTORE USER-S *PFP* # 
  
      END  # SSDEF #
  
    TERM
PROC DFCAT; 
# TITLE DFCAT - INITIALIZE 8 *M860* CATALOGS.                          #
  
      BEGIN  # DFCAT #
  
# 
**    DFCAT - INITIALIZE 8 *M860* CATALOGS. 
* 
*     THIS PROCEDURE PERFORMS THE INITIALIZATION PROCESSING 
*     FOR EACH *M860* CATALOG OF THE 8 SUB-FAMILIES.
* 
*     PROC      DFCAT 
* 
*     ENTRY     INITIALIZATION FOR CATALOG AND MAP ACCESS COMPLETED.
* 
*     EXIT      M860 CATALOGS INITIALIZED OR ERROR CONDITIONS 
*               DEFINED BELOW.
* 
*     MESSAGES  1) PFN=PFN, FAMILY=FAMILY,
*                   UI=UI - ALREADY PERMANENT.
* 
*               2) PFN=PFN, FAMILY=FAMILY,
*                   UI=UI - FILE INITIALIZED. 
* 
*               3) PFN=PFN, FAMILY=FAMILY,
*                   UI=UI - CIO ERROR.
* 
*               4) PFN=PFN, FAMILY=FAMILY,
*                   UI=UI - DEFINE ERROR. 
* 
*               5) PFN=PFN, FAMILY=FAMILY,
*                   UI=UI - FAMILY NOT FOUND. 
* 
*               6) SSDEF ABNORMAL - DFCAT.
# 
  
# 
****  PROC DFCAT - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC BZFILL;                 # BLANK OR ZERO FILLS FIELD #
        PROC CINIT;                  # INITIALIZES M860 CATALOGS #
        PROC DELAY;                  # CALLS *RECALL* MACRO # 
        PROC GETFAM;                 # GETS DEFAULT FAMILY #
        PROC LOFPROC;                # LIST OF FILES PROCESSOR #
        PROC MESSAGE;                # SENDS MESSAGE TO DAYFILE # 
        PROC PF;                     # *PFM* REQUEST INTERFACE #
        PROC RECALL;                 # PERIODIC RECALL #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT 
                                       OR RETURN #
        PROC RETERN;                 # RETURNS A FILE # 
        PROC REWIND;                 # CALLS *REWIND* MACRO # 
        PROC RPHR;                   # READS A *PRU* FROM FILE #
        PROC SETPFP;                 # SETS USER INDEX AND FAMILY # 
        FUNC XCOD;                   # CHANGES INTEGER TO DISPLAY # 
        PROC XWOD;                   # CHANGES OCTAL TO DISPLAY # 
        PROC ZSETFET;                # SETS UP *FET* FIELDS # 
        END 
  
# 
****  PROC DFCAT - XREF LIST END. 
# 
  
      DEF BLANK   #" "#;             # DISPLAY CODE FOR BLANK # 
      DEF COMMA      #","#;          # DISPLAY CODE FOR COMMA # 
      DEF FILLSIZE   #7#;            # FILL SIZE FOR BZFILL # 
      DEF REQUESTDEF #0#;            # DEFAULT FAMILY REQUESTED # 
      DEF UN         #0#;            # USER NUMBER #
  
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS # 
  
*CALL COMBFAS 
*CALL COMBBZF 
*CALL COMBCMD 
*CALL COMBCMS 
*CALL COMBFET 
*CALL COMBPFP 
*CALL COMSPFM 
*CALL COMTDEF 
*CALL COMTDFP 
  
      ITEM BLKFILL    S:TYPFILL = S"BFILL";  # BLANK FILL FOR BZFILL #
      ITEM BUSY       B;             # FILE BUSY FLAG # 
      ITEM ERCINIT    U;             # *CINIT* RETURN CODE #
      ITEM FILE$DONE  B;             # FILE PROCESSING DONE FLAG #
      ITEM FOUND      B;             # CHARACTER FOUND FLAG # 
      ITEM I          U;             # LOOP INDEX # 
      ITEM J          U;             # DUMMY LOOP INDEX # 
      ITEM K          U;             # DUMMY LOOP INDEX # 
      ITEM MSGTEMP    C(8);          # TEMPORARY MESSAGE FIELD #
      ITEM STAT       U;             # STATUS FROM ATTACH # 
      ITEM STATUSR    U;             # RETURN STATUS #
      ITEM UI         U;             # USER INDEX # 
  
      ARRAY CAT [0:0] P(1); 
        BEGIN  # CAT #
        ITEM CAT$PFN    C(00,00,07) = ["SFMCAT "];  # NAME HEADER # 
        ITEM CAT$LST    C(00,36,01);  # UNIQUE IDENTIFIER # 
        END  # CAT #
  
      ARRAY MSGDETAIL1 [0:0] P(4);
        BEGIN  # ARRAY MSGDETAIL1 # 
        ITEM LEAD1      C(00,00,01) = [" "];  # LEADING BLANK # 
        ITEM MSGPFNH    C(00,06,04) = ["PFN="];  # PFN= # 
        ITEM MSGPFN     C(00,30,07);  # FILE NAME # 
        ITEM MSGFAMH    C(01,12,09) = [", FAMILY="];  # FAMILY= # 
        ITEM MSGFAM     C(02,06,08);  # FAMILY AND COMMA #
        ITEM MSGZRO1    U(03,00,12) = [0];  # TERMINATOR #
        END  # ARRAY MSGDETAIL1 # 
  
# 
*     SWITCH FOR *CINIT* ERROR RETURN.
# 
  
      SWITCH  ERJMP:CMASTAT 
             NOERRJ:NOERR,           # FILE INITIALIZED # 
            INTLZDJ:INTLZD,          # ALREADY PERMANENT #
            CIOERRJ:CIOERR,          # CIO ERROR #
            DEFERRJ:DEFERR;          # DEFINE ERROR # 
                                               CONTROL EJECT; 
  
# 
*     IF *FM* SPECIFIED GET DEFAULT FAMILY. 
# 
  
      IF DARG$FM EQ REQUESTDEF
      THEN
        BEGIN  # DEFAULT FAMILY REQUESTED # 
        GETFAM(FAMT,NDF,LINKDF,DEFAULTDF);  # GET DEFAULT FAMILY #
        DARG$FM = FAM$NAME[DEFAULTDF];  # PUT NAME INTO ARGUMENT ARRAY
                                        # 
        DFLTFMDF = TRUE;             # SET DEFAULT FAMILY FLAG #
        END  # DEFAULT FAMILY REQUESTED # 
  
# 
*     BLANK FILL FAMILY NAME AND MOVE IT INTO DETAIL MESSAGE. 
# 
  
      MSGTEMP = DARG$FM;             # TEMPORARY BUFFER FOR BZFILL #
      BZFILL(MSGTEMP,BLKFILL,FILLSIZE);  # BLANK FILL # 
      MSGFAM[0] = MSGTEMP;           # SET FAMILY INTO MESSAGE #
  
# 
*     PLACE COMMA AFTER FAMILY NAME.
# 
  
      FOUND = FALSE;                 # FLAG TO INDICATE BLANK FOUND # 
      FASTFOR I = 0 STEP 1 WHILE NOT FOUND
      DO
        BEGIN 
        IF C<I,1>MSGFAM EQ BLANK
        THEN
          BEGIN  # CHARACTER AT INDEX IS BLANK #
          FOUND = TRUE; 
          C<I,1>MSGFAM = COMMA;      # CHANGE BLANK TO COMMA #
          END  # CHARACTER AT INDEX IS BLANK #
  
        END 
  
# 
*     IF *ERRFLAGDF* NOT SET, CALL *CINIT* FOR EACH SUBFAMILY.
# 
  
      ERRFLAGDF = FALSE;
  
  
      IF NOT ERRFLAGDF
      THEN
        BEGIN  # *CINIT* CALLS #
        SLOWFOR I = 0 STEP 1 WHILE I LQ MAXSF 
        DO
          BEGIN  # FOR EACH SUBFAMILY # 
          UI = DEF$UI + I;           # CALCULATE USER INDEX # 
          XWOD(UI,DIS);              # CHANGE FROM OCTAL TO DISPLAY # 
          MSGUIDF[0] = DIS$UI;       # PLACE USER INDEX INTO MESSAGE #
  
          CAT$LST[0] = XCOD(I);      # CHANGE INDEX TO DISPLAY CODE # 
          MSGPFN = CAT$PFN;          # FILE NAME TO MESSAGE # 
  
          PFP$UI[0] = UI;            # SET USER INDEX FOR *SETPFP* #
          PFP$FAM[0] = DARG$FM;      # SET FAMILY NAME FOR *SETPFP* # 
          PFP$FG1[0] = TRUE;         # SET FAMILY BIT FOR *SETPFP* #
          PFP$FG4[0] = TRUE;         # SET INDEX BIT FOR *SETPFP* # 
  
          SETPFP(PFP);               # SET USER INDEX AND FAMILY #
  
          IF PFP$STAT NQ 0
          THEN
            BEGIN 
            MSGDETMSG[0] = "FAMILY NOT FOUND."; 
            MESSAGE(MSGDETAIL1,SYSUDF1);  # SEND MESSAGE TO DAYFILE # 
            MESSAGE(MSGDETAIL2,SYSUDF1);
  
            ERRFAMDF = TRUE;
            END 
  
          IF ERRFAMDF 
          THEN
            BEGIN 
            TEST I; 
            END 
  
# 
*     *CINIT* IS CALLED TO INITIALIZE AN *M860* CATALOG IF THE
*     CATALOG IS CURRENTLY UNDEFINED.  IF THE CATALOG IS ALREADY
*     PERMANENT, IT IS CHECKED TO DETERMINE WHETHER IT IS A VALID 
*     CATALOG OR WHETHER IT IS AN EMPTY CATALOG CREATED BY
*     *PFDUMP* FOR INTERLOCKING PURPOSES.  IF IT IS A *PFDUMP*
*     CATALOG, IT IS PURGED AND INITIALIZED BY *CINIT*. 
* 
*     NOTE - *PFDUMP* CATALOGS ARE EMPTY AND CONSEQUENTLY CAN BE
*            IDENTIFIED BY REACHING AN *EOI* ON AN ATTEMPT TO READ
*            A *PRU*. 
# 
  
          FILE$DONE = FALSE;
          LOFPROC(CAT$PFN[0]);       # ADD LFN TO LIST OF FILES # 
          SLOWFOR J=0 WHILE NOT FILE$DONE 
          DO
            BEGIN  # CREATE CATALOG OR VERIFY ITS VALIDITY #
            ZSETFET(TFETADR,CAT$PFN[0],TBUFADR,TBUFL,RFETL);
            RETERN(TFET,RCL); 
            CINIT(DARG$FM,I,CAT$PFN[0],ERCINIT);
  
# 
*     PROCESS *CINIT* ERROR CODE. 
# 
  
            IF ERCINIT LS CMASTAT"NOERR" OR ERCINIT GR CMASTAT"STATLAST 
  " 
            THEN
              BEGIN  # IF *ERCINIT* OUT OF RANGE #
              MSG$LINE[0] = " SSDEF ABNORMAL, DFCAT.";
              MESSAGE(MSG$BUF[0],SYSUDF1);
              RESTPFP(PFP$ABORT);    # RESTORE USER-S *PFP* AND ABORT # 
              END  # IF *ERCINIT* OUT OF RANGE #
  
  
  
# 
*     SIMULATED CASE STATEMENT FOR PROCESSING AN ERROR RESPONSE.
# 
  
            GOTO ERJMP[ERCINIT];
  
NOERRJ:                              # FILE INITIALIZED # 
            MSGDETMSG[0] = "FILE INITIALIZED. ";
            MESSAGE(MSGDETAIL1,UDFL1);
            MESSAGE(MSGDETAIL2,UDFL1);
            GOTO ENDCASE; 
  
INTLZDJ:                             # ALREADY PERMANENT #
            ZSETFET(TFETADR,CAT$PFN[0],TBUFADR,TBUFL,RFETL);
  
            BUSY = TRUE;
            SLOWFOR K=0 WHILE BUSY
            DO
              BEGIN  # ATTACH *M860* CATALOG #
              PF("ATTACH",CAT$PFN[0],0,"RC",STAT,"NA",0,0); 
  
              IF STAT EQ FBS
              THEN
                BEGIN  # DELAY AND RETRY *ATTACH* # 
                STATUSR = 0;
                RECALL(STATUSR);     # PERIODIC RECALL #
                TEST K; 
                END  # DELAY AND RETRY *ATTACH* # 
  
              BUSY = FALSE; 
              END  # ATTACH *M860* CATALOG #
  
            REWIND(TFET[0],RCL);
            RPHR(TFET[0],RCL);
  
            IF FET$AT NQ 0
            THEN
              BEGIN 
              MSGDETMSG[0] = " CIO ERROR. ";
              GOTO ERRCASE; 
              END 
  
            IF FET$EOI
            THEN
              BEGIN  # EMPTY *PFDUMP* CREATED FILE FOUND #
              PF("PURGE",CAT$PFN[0],"RC",STAT,0); 
  
              IF STAT NQ 0
              THEN
                BEGIN 
                MSG$LINE[0] = " SSDEF ABNORMAL, DFCAT.";
                MESSAGE(MSG$BUF[0],SYSUDF1);
                RESTPFP(PFP$ABORT);  # RESTORE USER-S *PFP* AND ABORT # 
                END 
  
              TEST J; 
              END  # EMPTY *PFDUMP* CREATED FILE FOUND #
  
            ELSE                     # NOT *PFDUMP* CATALOG # 
              BEGIN 
              MSGDETMSG[0] = "ALREADY PERMANENT. "; 
            MESSAGE(MSGDETAIL1[0],SYSUDF1); 
            MESSAGE(MSGDETAIL2[0],SYSUDF1); 
              ERRFLAGDF = TRUE; 
              GOTO ENDCASE; 
              END 
  
CIOERRJ:                             # *CIO* ERROR #
            MSGDETMSG[0] = "CIO ERROR. "; 
            GOTO ERRCASE; 
  
DEFERRJ:                             # *DEFINE* ERROR # 
            MSGDETMSG[0] = "DEFINE ERROR. ";
            GOTO ERRCASE; 
  
  
ERRCASE:  
            MESSAGE(MSGDETAIL1,SYSUDF1);
            MESSAGE(MSGDETAIL2,SYSUDF1);
            ERRFLAGDF = TRUE; 
            RETURN; 
  
ENDCASE:  
            FILE$DONE = TRUE; 
  
  
# 
*     END OF CASE STATEMENT FOR PROCESSING AN ERROR RESPONSE. 
# 
  
            END  # CREATE CATALOG OR VERIFY ITS VALIDITY #
  
          END  # FOR EACH SUBFAMILY # 
  
        END  # *CINIT* CALLS #
  
  
  
      END  # DFCAT #
  
    TERM
PROC DFMAP; 
# TITLE DFMAP - INITIALIZES *SMMAP* FOR THE *SM*  SPECIFIED.          # 
  
      BEGIN  # DFMAP #
  
# 
**    DFMAP - INITIALIZES *SMMAP* FOR THE *SM* SPECIFIED. 
* 
*     THIS PROCEDURE PERFORMS THE INITIALIZATION PROCESSING 
*     FOR THE *SM* SPECIFIED. 
* 
*     PROC      DFMAP 
* 
*     ENTRY     INITIALIZATION FOR CATALOG AND MAP ACCESS COMPLETED.
* 
*     EXIT      MAP INITIALIZED OR ERROR CONDITIONS 
*               DEFINED BELOW.
* 
*     MESSAGES  1) PFN=PFN, FAMILY=FAMILY,
*                   UI=UI - FILE INITIALIZED. 
* 
*               2) PFN=PFN, FAMILY=FAMILY,
*                   UI=UI - ALREADY PERMANENT.
* 
*               3) PFN=PFN, FAMILY=FAMILY,
*                   UI=UI - DEFINE ERROR. 
* 
*               4) SSDEF ABNORMAL, DFMAP. 
# 
  
# 
****  PROC DFMAP - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC BZFILL;                 # BLANK OR ZERO FILLS FIELD #
        PROC GETFAM;                 # GETS DEFAULT FAMILY #
        PROC LOFPROC;                # LIST OF FILES PROCESSOR #
        PROC MESSAGE;                # CALLS MESSAGE MACRO #
        PROC MINIT;                  # INITIALIZES SMMAP #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT 
                                       OR RETURN #
        PROC RETERN;                 # RETURNS A FILE # 
        PROC SETPFP;                 # SETS USER INDEX AND FAMILY # 
        PROC XWOD;                   # CHANGES OCTAL TO DISPLAY CODE #
        PROC ZSETFET;                # SETS UP *FET* FIELDS # 
        END 
  
# 
****  PROC DFMAP - XREF LIST END. 
# 
  
      DEF BLANK   #" "#;             # DISPLAY CODE FOR BLANK # 
      DEF COMMA      #","#;          # DISPLAY CODE FOR COMMA # 
      DEF FILLSIZE   #7#;            # FILL SIZE FOR BZFILL # 
      DEF R          #1#;            # REQUEST RECALL FLAG #
  
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS # 
  
*CALL COMBFAS 
*CALL COMBBZF 
*CALL COMBCMD 
*CALL COMBCMS 
*CALL COMBPFP 
*CALL COMTDEF 
*CALL COMTDFP 
  
      ITEM BLKFILL    S:TYPFILL = S"BFILL";  # BLANK FILL FOR BZFILL #
      ITEM ERMINIT    U;             # MINIT RETURN CODE #
      ITEM FOUND      B;             # CHARACTER FOUND FLAG # 
      ITEM I          U;             # LOOP INDEX # 
      ITEM MSGTEMP    C(8);          # TEMPORARY MESSAGE FIELD #
      ITEM ZEROFILL   S:TYPFILL = S"ZFILL";  # ZERO FILL FOR BZFILL # 
  
  
      ARRAY MAP [0:0] P(1); 
        BEGIN  # MAP #
        ITEM MAP$PFN    C(00,00,07) = ["SMMAP"];  # FILE NAME HEADER #
        ITEM MAP$LST    C(00,30,01);  # UNIQUE IDENTIFIER # 
        END  # MAP #
  
      ARRAY MSGDETAIL0 [0:0] P(3);
        BEGIN  # ARRAY MSGDETAIL0 # 
        ITEM LEAD0      C(00,00,01) = [" "];  # LEADING BLANK # 
        ITEM MSGPFNH0   C(00,06,04) = ["PFN="];  # PFN= # 
        ITEM MSGPFN0    C(00,30,06);  # FILE NAME # 
        ITEM MSGFAMH0   C(01,06,09) = [", FAMILY="];  # FAMILY= # 
        ITEM MSGFAM0    C(02,00,08);  # FAMILY AND COMMA #
        ITEM MSGZRO0    U(02,48,12) = [0];  # TERMINATOR #
        END  # ARRAY MSGDETAIL0 # 
  
      SWITCH  ERJMP:CMASTAT 
             NOERRJ:NOERR,           # FILE INITIALIZED # 
            INTLZDJ:INTLZD,          # ALREADY PERMANENT #
            DEFERRJ:DEFERR;          # DEFINE ERROR # 
                                               CONTROL EJECT; 
  
# 
*     CHECK FOR DEFAULT FAMILY. 
# 
  
      IF NOT DFLTFMDF 
      THEN
        BEGIN  # DEFAULT FAMILY NOT PREVIOUSLY DEFINED #
        GETFAM(FAMT,NDF,LINKDF,DEFAULTDF);  # GET DEFAULT FAMILY #
        DARG$FM = FAM$NAME[DEFAULTDF];  # PUT NAME INTO ARGUMENT ARRAY
                                        # 
        END  # DEFAULT FAMILY NOT PREVIOUSLY DEFINED #
  
# 
*     BLANK FILL FAMILY NAME AND MOVE IT TO DETAILED MESSAGE. 
# 
  
      MSGTEMP = DARG$FM;             # TEMPORARY BUFFER FOR BZFILL #
      BZFILL(MSGTEMP,BLKFILL,FILLSIZE);  # BLANK FILL # 
      MSGFAM0[0] = MSGTEMP;          # SET FAMILY INTO MESSAGE #
  
# 
*     PLACE COMMA AFTER FAMILY NAME.
# 
  
      FOUND = FALSE;                 # FLAG TO INDICATE BLANK FOUND # 
      FASTFOR I = 0 STEP 1 WHILE NOT FOUND
      DO
        BEGIN 
        IF C<I,1>MSGFAM0 EQ BLANK 
        THEN
          BEGIN  # CHARACTER AT INDEX IS BLANK #
          FOUND = TRUE; 
          C<I,1>MSGFAM0 = COMMA;     # CHANGE BLANK TO COMMA #
          END  # CHARACTER AT INDEX IS BLANK #
  
        END 
  
  
# 
*     CALL *SETPFP* TO SET USER INDEX AND FAMILY. 
# 
  
      XWOD(DEF$UI,DIS);              # CHANGE OCTAL TO DISPLAY CODE # 
      MSGUIDF[0] =  DIS$UI;          # SET USER INDEX INTO MESSAGE #
  
      MAP$LST[0] = DARG$SM;          # CREATE NAME FOR *MINIT* CALL # 
      MSGPFN0[0] = MAP$PFN[0];       # PLACE FILE NAME INTO MESSAGE # 
  
      PFP$UI[0] = DEF$UI;            # SET USER INDEX FOR *SETPFP* #
      PFP$FAM[0] = DARG$FM;          # SET FAMILY NAME FOR *SETPFP* # 
      PFP$FG1[0] = TRUE;             # SET FAMILY BIT FOR *SETPFP* #
      PFP$FG4[0] = TRUE;             # SET INDEX BIT FOR *SETPFP* # 
  
      SETPFP(PFP);                   # SET USER INDEX AND FAMILY #
      IF PFP$STAT NQ 0
      THEN
        BEGIN 
        MSG$LINE[0] = " SSDEF ABNORMAL, DFMAP.";
        MESSAGE(MSG$BUF[0],SYSUDF1);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT # 
        END 
  
# 
*     CALL *MINIT* TO INITIALIZE **SM*MAP* FOR SPECIFIED *SM*.
# 
  
  
  
      BZFILL(MAP,ZEROFILL,FILLSIZE);  # ZERO FILL # 
      ZSETFET(TFETADR,MAP$PFN[0],TBUFADR,TBUFL,RFETL);
      RETERN(TFET,RCL); 
      LOFPROC(MAP$PFN[0]);           # ADD LFN TO LIST OF FILES # 
      MINIT(MAP$PFN[0],DARG$IRSM,ERMINIT);  # INITIALIZE *SMMAP* #
  
# 
*     PROCESS *MINIT* ERROR CODE. 
# 
  
      IF ERMINIT LS CMASTAT"NOERR" OR ERMINIT GR CMASTAT"STATLAST"
        THEN
        BEGIN  # IF *ERMINIT* OUT OF RANGE #
        MSG$LINE[0] = " SSDEF ABNORMAL, DFMAP.";
        MESSAGE(MSG$BUF[0],SYSUDF1);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT # 
        END  # IF *ERMINIT* OUT OF RANGE #
  
  
  
# 
*     SIMULATED CASE STATEMENT FOR PROCESSING AN ERROR RESPONSE.
# 
  
      GOTO ERJMP[ERMINIT];
  
  
NOERRJ:                              # FILE INITIALIZED # 
      MSGDETMSG[0] = "FILE INITIALIZED. ";
      GOTO ENDCASEOK; 
  
INTLZDJ:                             # ALREADY PERMANENT #
      MSGDETMSG[0] = "ALREADY PERMANENT. "; 
      ERRFLAGDF = TRUE; 
      GOTO ENDCASE; 
  
DEFERRJ:                             # *DEFINE* ERROR # 
      MSGDETMSG[0] = "DEFINE ERROR. ";
      ERRFLAGDF = TRUE; 
  
ENDCASE:  
      MESSAGE(MSGDETAIL0,SYSUDF1);
      MESSAGE(MSGDETAIL2,SYSUDF1);
      RETURN; 
  
# 
*     END OF CASE STATEMENT FOR PROCESSING AN ERROR RESPONSE. 
# 
  
  
ENDCASEOK:  
      MESSAGE(MSGDETAIL0,UDFL1);
      MESSAGE(MSGDETAIL2,UDFL1);
      RETURN; 
  
  
      END  # DFMAP #
  
    TERM
