Retro1.org codex

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