Retro1.org codex

PRGM SSBLD;
 
 
# TITLE SSBLD - MAIN ROUTINE OF SSBLD.                                #
 
      BEGIN  # SSBLD #
 
#
***   SSBLD - BUILD UDT FOR SSEXEC.
*
*     SSBLD ATTACHES THE FILE SPECIFIED BY THE CONTROL STATEMENT
*     CALL AND BUILDS A DIRECT ACCESS PERMANENT FILE - BUDT
*     UNDER USER INDEX 377760B.
*
*
*     SSBLD(PARAMETER1,PARAMTER2)      - PARAMETERS ARE OPTIONAL.
*
*     PARAMETER     DESCRIPTION
*
*     CF            USE DIRECT ACCESS PERMANENT FILE *SUDT* UNDER
*                   UI = 377760B AS INPUT FOR BUILDING THE UDT.
*
*     CF=LFN        USE DIRECT ACCESS PERMANENT FILE *LFN* UNDER
*                   UI = 377760B AS INPUT FOR BUILDING THE UDT.
*
*     CF OMITTED    SAME AS CF.
*
*     BF            USE DIRECT ACCESS PERMANENT FILE *BUDT* UNDER
*                   UI = 377760B FOR DESTINATION BUDT FILE.
*
*     BF=LFN        USE DIRECT ACCESS PERMANENT FILE *LFN* UNDER
*                   UI = 377760B FOR DESTINATION BUDT FILE.
*
*     BF OMITTED    SAME AS BF.
*
*     MESSAGES
*
*     SSBLD ABORT - SYNTAX ERROR.
*      SSBLD - MUST BE SYSTEM ORIGIN.
*     SSBLD - CANNOT RE-ATTACH BUDT FILE.
*     SSBLD - NO SOURCE CONFIGURATION FILE.
*     SSBLD - SUDT FILE BUSY.
*     SSBLD - BUDT FILE BUSY.
*     SSBLD - UNABLE TO DEFINE BUDT FILE.
*     SSBLD - BUDT FILE PROBLEMS.
*     SSBLD - COMPLETE.
*
*
*
*     COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
#
 
#
****  PRGM SSBLD - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # CALLS *ABORT* MACRO #
        PROC BLTAB;                  # SETS UP ARGUMENT LIST #
        PROC BZFILL;                 # BLANK OR ZERO FILL A BUFFER #
        PROC GETPFP;                 # GET USER INDEX AND FAMILY #
        PROC GETSPS;                 # GET SYSTEM ORIGIN PRIVILEDGES #
        PROC MESSAGE;                # CALLS MESSAGE MACRO #
        PROC NEXTLIN;                # READ NEXT LINE #
        PROC PFD;                    # *PFM* REQUEST INTERFACE #
        PROC RDSUDT;                 # READ CONFIGURATION FILE SOURCE #
        PROC RETERN;                 # RETURN A FILE #
        PROC RESTPFP;                # RESTORE USER-S *PFP* #
        PROC WTBUDT;                 # WRITE UDT TO DISK FILE #
        PROC XARG;                   # CRACK PARAMETER LIST #
        END
 
#
****  PRGM SSBLD - XREF LIST END.
#
 
      DEF SMMAX      #"H"#;          # MAXIMUM SM VALUE #
      DEF SMMIN      #"A"#;          # MINIMUM SM VALUE #
      DEF NOPARAM    #-1#;           # NO PARAMETER SPECIFIED #
      DEF PROCNAME   #"SSBLD."#;     # PROCEDURE NAME #
      DEF RSLEN      #1#;        # RETURN STATUS LENGTH #
      DEF SYNTAXOK   #0#;            # SYNTAX OK #
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
 
                                               CONTROL PRESET;
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBCMD
*CALL COMBCMS
*CALL COMBPFP
*CALL COMBUDT
*CALL COMSPFM
*CALL COMTBLD
*CALL COMTBLP
 
      ITEM ARGLIST    U;             # ADDRESS OF ARGUMENT TABLE #
      ITEM FLAG       U;             # ERROR FLAG FOR ASARG #
      ITEM OPTION     I;             # OPTION TO SKIP PROGRAM NAME #
 
      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 #
 
 
      ARRAY SPSSTAT [0:0] S(RSLEN);
        BEGIN
        ITEM SPS$STATUS U(00,48,12); # RETURN STATUS #
        END
 
                                               CONTROL EJECT;
 
#
*     GET SYSTEM ORIGIN PRIVILEDGES.
#
 
      GETSPS(SPSSTAT);
      IF SPS$STATUS NQ 0
      THEN
        BEGIN
        BLMSG$LN[0] = " SSBLD - MUST BE SYSTEM ORIGIN.";
        MESSAGE(BLMSG[0],SYSUDF1);
        ABORT;                       # ABORT #
        END
 
#
*     SAVE THE USER-S CURRENT FAMILY AND INDEX IN COMMON.
#
 
      GETPFP(PFP[0]);
      USER$FAM[0] = PFP$FAM[0];
      USER$UI[0] = PFP$UI[0];
 
 
#
*     CRACK THE PARAMETERS ON THE *SSBLD* CALL.
#
 
      BLTAB(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
        BLMSG$LN[0] = " SSBLD ABORT - SYNTAX ERROR.";
        MESSAGE(BLMSG[0],SYSUDF1);     # SYNTAX ERROR MESSAGE #
        RESTPFP(PFP$ABORT);          # RESTORE USER-S *PFP* AND ABORT #
        END
 
#
*     ATTACH SSEXEC UDT SOURCE FILE.
#
 
      CFNAME = DARG$CF[0];
      BZFILL(CFNAME,TYPFILL"ZFILL",7);  # ZERO FILL FILE NAME #
        BEGIN
        PFD("ATTACH",CFNAME,0,"M","R","RC",FLAG,"NA",0,0);
        IF FLAG NQ OK
        THEN
          BEGIN  # PROCESS ATTACH ERROR FLAG #
          IF FLAG EQ FBS
          THEN                       # SSEXEC UDT SOURCE FILE BUSY #
            BEGIN
            BLMSG$LN[0] = " SSBLD - SUDT FILE BUSY.";
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);      # RETORE USER-S PFP AND ABORT #
            END
 
            BEGIN
            BLMSG$LN[0] = " SSBLD - NO SOURCE CONFIGURATION FILE. ";
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
            END
 
          END  # PROCESS ATTACH ERROR FLAG #
 
        END
 
#
*     ATTACH SSEXEC UDT BINARY FILE.
#
 
      CFNAME = DARG$BF[0];
      BZFILL(CFNAME,TYPFILL"ZFILL",7);
        BEGIN
        PFD("ATTACH",CFNAME,0,"M","W","RC",FLAG,"NA",0,"PW",BUDTPW,0);
        IF FLAG NQ OK
        THEN
          BEGIN  # PROCESS ATTACH ERROR FLAG #
          IF FLAG EQ FBS
          THEN                       # COMMUNICATION FILE BUSY #
            BEGIN
            BLMSG$LN[0] = " SSBLD - BUDT FILE BUSY.";
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
            END
 
          IF FLAG EQ FNF
          THEN                       # FILE DOES NOT EXIST #
            BEGIN
            PFD("DEFINE",CFNAME,0,"RC",FLAG,0,"PW",BUDTPW,0);
            IF FLAG NQ OK
            THEN                     # PROCESS DEFINE ERROR #
              BEGIN
              BLMSG$LN[0] = " SSBLD - UNABLE TO DEFINE BUDT FILE.";
              MESSAGE(BLMSG[0],SYSUDF1);
              RESTPFP(PFP$ABORT);    # RESTORE USER-S *PFP* AND ABORT #
              END
 
            END
 
          ELSE                       # ABNORMAL TERMINATION #
            BEGIN
            BLMSG$LN[0] = " SSBLD - BUDT FILE PROBLEMS. ";
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S *PFP* AND ABORT #
            END
 
          END  # PROCESS ATTACH ERROR FLAG #
 
        END
 
#
*     READ THE CONFIGURATION SOURCE FILE AND GENERATE UDT.
#
 
      RDSUDT;
 
#
*     WRITE THE UDT TO DISK.
#
 
      WTBUDT;
 
#
*     REATTACH UDT FILE, CLEANUP, AND EXIT.
#
 
      PFD("ATTACH",CFNAME,0,"M","R","RC",FLAG,"PW",BUDTPW,0);
      IF FLAG NQ OK
      THEN                           # PERMANENT FILE PROBLEM #
        BEGIN
        BLMSG$LN[0] = " SSBLD - CANNOT RE-ATTACH BUDT FILE.";
        MESSAGE(BLMSG[0],SYSUDF1);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S PFP AND ABORT #
        END
 
      RETERN(BL$FET[0],RCL);
      BLMSG$LN[0] = " SSBLD COMPLETE.";  # SSBLD COMPLETE #
      MESSAGE(BLMSG[0],UDFL1);
      RESTPFP(PFP$END);              # RESTORE USER-S *PFP* #
 
      END  # SSBLD #
 
    TERM
PROC RDSUDT;
 
 
# TITLE RDSUDT - READ *SUDT* OR OTHER SPECIFIED FILE TO MEMORY.       #
 
      BEGIN  # RDSUDT #
 
#
**    RDSUDT - READ CONFIGURATION SOURCE FILE TO MEMORY.
*
*     THIS PROCEDURE READS THE M860 CONFIGURATION SOURCE
*     FILE TO SSBLD-S MEMORY FOR INTERPRETATION PRIOR
*     TO SSBLD GENERATING THE *BUDT* FILE.
*     RDSUDT READS THE CONFIGURATION FILE ONE LINE AT
*     TIME. THESE STATEMENTS MUST APPEAR IN A SPECIFIED ORDER.
*     IF NOT, RDSUDT WILL ABORT THE JOB.  THE ORDER IS:
*
*       ALL *CU* STATEMENTS APPEAR FIRST.
*       ALL *CIF* STATEMENTS APPREAR NEXT.
*       ALL *DTI* STATEMENTS APPEAR NEXT.
*       ALL *DTO* STATEMENTS APPEAR NEXT.
*       ALL *DIF* STATEMENTS APPEAR NEXT.
*       ALL *DRC* STATEMENTS APPEAR NEXT.
*       ALL *DRD* STATEMENTS APPEAR NEXT.
*       ALL *AIF* STATEMENTS APPEAR NEXT.
*       ALL *SM* STATEMENTS APPEAR LAST.
*
*     THE ABOVE STATEMENTS ARE THE ONLY LEGAL MNEMONIC
*     DESCRIPTORS ALLOWED. USE OF ANY OTHER DESCRIPTOR
*     WILL CAUSE *SSBLD* TO ABORT.
*
*     AN ASTERISK (*) IN COLUMN ONE INDICATES A COMMENT
*     STATEMENT.
*
*
*     PROC RDSUDT.
*
*     ENTRY   NONE.
*
*     EXIT    CONFIGURATION SOURCE FILE READ TO MEMORY.
*             IT WILL BE SCANNED FOR SYNTACTICAL CORRECTNESS
*             AND CORRECT ORDER.
*
*     MESSAGES
*
*     RDSUDT - CONFIGURATION FILE EMPTY.
*     RDSUDT - INCORRECT *CU* COUNT.
*     RDSUDT - MISSING *SM* COUNT COMMAND.
*     RDSUDT - CAN-T CRACK *SM* COMMAND.
*     RDSUDT - CH/CIF CONFLICT.
*     RDSUDT - INCORRECT *SM* COUNT.
*     RDUSDT - NULL DIRECTIVE.
*     RDSUDT - *CU* COMMAND MISSING/OUT OF PLACE.
*     RDSUDT - INCORRECT EST ORDINAL.
*     RDSUDT - *CU* ENTRY MISSING = SIGN.
*     RDSUDT - CHANNEL 0 NOT FIRST CHANNEL.
*     RDSUDT - MISSING CHANNELS ON *CU* COMMAND.
*     RDSUDT - *CIF* COMMAND MISSING = SIGN.
*     RDSUDT - *DTI* COMMAND MISSING = SIGN.
*     RDSUDT - *DTO* COMMAND MISSING = SIGN.
*     RDSUDT - *DIF* COMMAND MISSING = SIGN.
*     RDSUDT - *DRC* COMMAND MISSING = SIGN.
*     RDSUDT - *AIF* COMMAND MISSING = SIGN.
*     RDSUDT - *SM* COMMAND MISSING = SIGN.
*     RDSUDT - *SM* COMMAND MISSING COMMA.
*     RDSUDT - INCORRECT DEVICE ADDRESS.
*     RDSUDT - EXTRA ENTRIES ON DIRECTIVE.
*     RDSUDT - INCORRECT CONFIGURATION FILE HEADER.
*     RDSUDT - STATEMENT OUT OF ORDER.
*     RDSUDT - INCORRECT STATUS.
*     RDSUDT - INCORRECT COMMAND TERMINATOR.
*     RDSUDT - EXTRA PATHS TO *DRD*.
*     RDSUDT - EXTRA PATHS TO *SM*.
*     RDSUDT - SOURCE FILE STATEMENT CONFLICT.
*     RDSUDT - COMMAND SYNTAX ERROR.
*     RDSUDT - INCORRECT STATEMENT MNEMONIC.
*     RDSUDT - STATEMENT OUT OF ORDER.
*     RDSUDT - CONFIGURATION FILE STATEMENT CONFLICT.
*     RDSUDT - SM STATEMENT - INCORRECT DS VALUE.
*     RDSUDT - SM STATEMENT - INCORRECT ST VALUE.
*     RDSUDT - INVALID AIF PATHS.
*
#
 
#
****  PROC RDSUDT - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC BZFILL;                 # BLANK OR ZERO FILLS AN ITEM #
        PROC MESSAGE;                # DISPLAYS MESSAGE IN DAYFILE #
        PROC NEXTLIN;                # READ NEXT LINE AND CHECK IT #
        PROC NEXTPRM;                # GET NEXT PARAMETER, CHECK IT #
        PROC READ;                   # READS A FILE #
        PROC READC;                  # READ ONE LINE #
        PROC READW;                  # DATA TRANSFER ROUTINE #
        PROC RESTPFP;                # RESTORE USER-S *PFP* AND ABORT
                                       OR RETURN #
        PROC RETERN;                 # RETURNS A FILE #
        PROC REWIND;                 # REWINDS A FILE #
        PROC UPDRDST;                # UPDATE NODE STATUS #
        FUNC XDXB;                   # CONVERT DISPLAY CODE TO BINARY #
        PROC ZFILL;                  # ZERO FILLS A BUFFER #
        PROC ZSETFET;                # SETS UP A FET #
        END
 
 
#
****  PROC RDSUDT - XREF LIST END.
#
 
      DEF MSG$BADEST #" RDSUDT - INCORRECT EST ORDINAL. "#;
      DEF MSG$BADADR #" RDSUDT - INCORRECT DEVICE ADDRESS. "#;
      DEF MSG$BADENT #" RDSUDT - EXTRA ENTRIES ON DIRECTIVE."#;
      DEF MSG$BADNUM #" RDSUDT - INCORRECT CONFIGURATION FILE HEADER."#;
      DEF MSG$BADST  #" RDSUDT - INCORRECT STATEMENT MNEMONIC."#;
      DEF MSG$BDORD  #" RDSUDT - STATEMENT OUT OF ORDER."#;
      DEF MSG$BDST   #" RDSUDT - INCORRECT STATUS."#;
      DEF MSG$BDTERM #" RDSUDT - INCORRECT COMMAND TERMINATOR. "#;
      DEF MSG$EXDRD  #" RDSUDT - EXTRA PATHS TO *DRD*."#;
      DEF MSG$EXPATH #" RDSUDT - EXTRA PATHS TO *SM*."#;
      DEF MSG$INCCU  #" RDUSDT - INCORRECT *CU* COUNT."#;
      DEF MSG$INCSM  #" RDSUDT - INCORRECT *SM* COUNT."#;
      DEF MSG$INVAIF #" RDSUDT - INVALID AIF PATHS."#;
      DEF MSG$SM$DS  #" RDSUDT - SM STATEMENT - INCORRECT DS VALUE."#;
      DEF MSG$SM$ST  #" RDSUDT - SM STATEMENT - INCORRECT ST VALUE."#;
      DEF MSG$STCON  #" RDSUDT - SOURCE FILE STATEMENT CONFLICT"#;
      DEF MSG$SYNER  #" RDSUDT - COMMAND SYNTAX ERROR"#;
      DEF PROCNAME   #"RDSUDT."#;    # PROC NAME #
      DEF ZERO       #0#;            # CONSTANT ZERO #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBFET
*CALL COMBTDM
*CALL COMBUDT
*CALL COMSPFM
*CALL COMTBLD
*CALL COMTBLP
*CALL COMTOUT
 
      ITEM ACCESSOR   I;             # DEVICE ADDRESS OF M861 #
      ITEM ARGLIST    I;             # ARGUMENT LIST ADDRESS #
      ITEM BUFP       I;             # FWA OF BUFFER #
      ITEM CHAR1      C(1);          # ONE CHARACTER #
      ITEM CHAR2      C(2);          # TWO CHARACTERS #
      ITEM CHAR3      C(3);          # THREE CHARACTERS #
      ITEM CUNUM      I;             # ORDINAL OF CURRENT *CU* #
      ITEM CUXX       I;             # ORDINAL OF PRIMARY *CU* #
      ITEM CUYY       I;             # ORDINAL OF SECONDARY *CU* #
      ITEM NCOL       I;             # NEXT COLUMN NUMBER #
      ITEM SCOL       I;             # STARTING COLUMN NUMBER #
      ITEM DEVTYPE    C(3);          # DEVICE NMEMONIC #
      ITEM DIRNUM     I;             # DIRECTIVE NUMBER #
      ITEM DIRLINE    C(90);         # DIRECTIVE TEXT LINE #
      ITEM DRDNUM     I;             # ORDINAL OF CURRENT *DRD* #
      ITEM EOR        B;             # END-OF-RECORD FLAG #
      ITEM FETP       I;             # FWA OF FET #
      ITEM FOUND      B;             # LOOP EXIT CONTROL #
      ITEM ARGKEY2    C(2);          # ARGUMENT KEY - 2 CHARACTERS #
      ITEM ARGKEY3    C(3);          # ARGUMENT KEY - 3 CHARACTERS #
      ITEM NKEY2      C(2);          # DIRECTIVE KEY - 2 CHARACTER #
      ITEM OKEY2      C(2);          # DIRECTIVE KEY - 2 CHARACTER #
      ITEM NKEY3      C(3);          # DIRECTIVE KEY - 3 CHARACTER #
      ITEM OKEY3      C(3);          # DIRECTIVE KEY - 3 CHARACTER #
      ITEM KEYOK      B;             # CONTROL VARIABLE #
      ITEM MASK       I;             # MASK FOR SPECIAL FILE NAMES #
      ITEM I          I;             # LOOP INDEX #
      ITEM J          I;             # LOOP INDEX #
      ITEM K          I;             # LOOP INDEX #
      ITEM LFN        C(7);          # FILE NAME #
      ITEM MAXARG     I;             # MAXIMUM NUMBER OF ARGUMENTS #
      ITEM LOOPC      B;             # LOOP CONTROL VARIABLE #
      ITEM LOOPK      B;             # LOOP CONTROL VARIABLE #
      ITEM LOOPL      B;             # LOOP CONTROL #
      ITEM NUMCH      I;             # NUMBER OF CHARACTERS #
      ITEM ORD        I;             # ORDINAL OF DEVICE TYPE #
      ITEM SAVEDORD   I;             # SAVED DRD ORDINAL #
      ITEM SMNUM      I;             # ORDINAL OF CURRENT *SM* #
      ITEM STAT       I;             # STATUS OF PROCEDURE CALL #
      ITEM TERMINATOR C(1);          # TERMINATING CHARACTER #
      ITEM TMPI       I;             # INTEGER SCRATCH #
      ITEM TMPJ       I;             # INTEGER SCRATCH #
 
      ARRAY MSG [1:2] S(2);          # MESSAGES DISPLAYED #
        BEGIN
        ITEM MSGW       C(00,00,20) =  ##
          [ "CONFIGURATION FILE READ ",
        "                    " ];
        END
 
 
 
#
*     SWITCH STATEMENT
#
 
      SWITCH DIRECTIVE NULL,
      M862CTLR,
      CHANIF,
      DEVICETI,
      DEVICETO,
      DEVICEIF,
      DATARC,
      NULL,
      ACCIF,
      NULL,
      M861SM;
 
 
 
                                               CONTROL EJECT;
 
#
*     SET UP FET FOR CONFIGURATION FILE AND REWIND IT.
#
 
      LFN = DARG$CF[0];
      FETP = LOC(BL$FET[0]);
      BUFP = LOC(BL$BUF[0]);
      ZSETFET(FETP,LFN,BUFP,BLBUFL,SFETL);
      READ(BL$FET[0],NRCL);
      EOR = FALSE;
 
#
*     READ FIRST 2 CARDS OF CONFIGURATION SOURCE FILE.
*     CARD 1 CONTAINS NUMBER OF CU-S (LEFT-JUSTIFIED)
*     CARD 2 CONTAINS NUMBER OF SM-S (LEFT-JUSTIFIED)
#
 
      READC(BL$FET[0],DIRLINE,9,STAT);
      BZFILL(DIRLINE,TYPFILL"BFILL",90);
      IF STAT NQ 0
      THEN
        BEGIN
        BLMSG$LN[0] = " RDSUDT - CONFIGURATION FILE EMPTY.";
        MESSAGE(BLMSG[0],SYSUDF1);
        END
 
      STAT = XDXB(C<0,1>DIRLINE,1,NUM$CU);
      IF STAT NQ 0
      THEN
        BEGIN
        BLMSG$LN[0] = MSG$BADENT;
        MESSAGE(BLMSG[0],SYSUDF1);
        RESTPFP(PFP$ABORT);
        END
 
      BLMSG$LN[0] = DIRLINE;
      MESSAGE(BLMSG[0],SYSUDF1);
      P<UDT$WORD> = LOC(BL$UDT$HDR);
      IF NUM$CU GR MAXCTN OR NUM$CU LQ ZERO
      THEN
        BEGIN
        BLMSG$LN[0] = MSG$INCCU;
        MESSAGE(BLMSG[0],SYSUDF1);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S PFP AND ABORT #
        END
 
#
*      SAVE COUNT OF M862-S
#
 
      UDT$LINE$CUN = NUM$CU;
 
      READC(BL$FET[0],DIRLINE,9,STAT);
      BZFILL(DIRLINE,TYPFILL"BFILL",90);
      IF STAT NQ 0
      THEN
        BEGIN
        BLMSG$LN[0] = " MISSING *SM* COUNT COMMAND.";
        MESSAGE(BLMSG[0],SYSUDF1);   # ERROR MESSAGE #
        RESTPFP(PFP$ABORT);          # RESTORE USER-S PFP AND ABORT #
        END
 
      STAT = XDXB(C<0,1>DIRLINE,1,NUM$SM);
      IF STAT NQ 0
      THEN
        BEGIN
        BLMSG$LN[0]= " RDSUDT - CAN-T CRACK *SM* COMMAND. ";
        MESSAGE(BLMSG[0],SYSUDF1);
        RESTPFP(PFP$ABORT);
        END
 
      BLMSG$LN[0] = DIRLINE;
      MESSAGE(BLMSG[0],SYSUDF1);
      IF NUM$SM GR MAXSM OR NUM$SM LQ ZERO
      THEN
        BEGIN
        BLMSG$LN[0] = MSG$INCSM;
        MESSAGE(BLMSG[0],SYSUDF1);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S PFP AND ABORT #
        END
 
      UDT$LINE$SMN = NUM$SM;
 
#
*      INITIALIZE *BUDT* POSITIONING COUNTERS.
#
 
      CUNUM = 0;
      SMNUM = 0;
 
#
*      READ DIRECTIVES FROM SOURCE FILE
#
 
 
      EOR = FALSE;
      SLOWFOR DIRNUM = 1 STEP 1 WHILE NOT EOR
      DO
        BEGIN
 
        NEXTLIN(DIRLINE,STAT,TMPI);
        IF STAT NQ 0
        THEN
          BEGIN
          EOR = TRUE;
          TEST DIRNUM;
          END
 
        BLMSG$LN[0] = DIRLINE;
        MESSAGE(BLMSG[0],SYSUDF1);
 
        GOTO DIRECTIVE[TMPI];
 
NULL:
        BLMSG$LN[0] = " RDSUDT - NULL DIRECTIVE. ";
        MESSAGE(BLMSG[0],SYSUDF1);
        RESTPFP(PFP$ABORT);
 
M862CTLR:
        CUNUM = CUNUM + 1;
        P<UDT$CN> = LOC(BL$UDT$M862[CUNUM]);
        ARGKEY2 = C<0,2>DIRLINE;
        ARGKEY3 = "   ";
        IF ARGKEY2 NQ NM$KEY2[2]
        THEN
          BEGIN
          BLMSG$LN[0] =              ##
            " RDSUDT - *CU* COMMAND MISSING/OUT OF PLACE.";
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);        # RESTORE USER-S PFP AND ABORT #
          END
 
        STAT = XDXB(C<2,3>DIRLINE,0,TMPI);  # ASSUME 3-CHAR EST ORD #
        SCOL = 5;
        IF STAT NQ 0
        THEN
          BEGIN
          STAT = XDXB(C<2,2>DIRLINE,0,TMPI);  # ASSUME 2-CHAR EST ORD #
          SCOL = 4;
          IF STAT NQ 0
          THEN                       # BAD EST ORDINAL #
            BEGIN  # EXIT #
            BLMSG$LN[0] = MSG$BADEST;
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);
            END  # EXIT #
 
          END
 
        IF (TMPI LS O"10") OR (TMPI GR MAXEST)
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADEST;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        UD$ESTO[1] = TMPI;
        IF C<SCOL,1>DIRLINE NQ "="
        THEN
          BEGIN
          BLMSG$LN[0] = " RDSUDT - *CU* ENTRY MISSING = SIGN.";
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        SCOL = SCOL + 1;
        CHAR1 = C<SCOL,1>DIRLINE;
        STAT = XDXB(CHAR1,0,TMPI);
        IF STAT NQ 0
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADEST;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF (TMPI EQ 1) OR (TMPI EQ 3) OR (TMPI EQ 5) OR (TMPI EQ 7)
          THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADEST;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        SCOL = SCOL + 1;
        IF C<SCOL,1>DIRLINE NQ COMMA
        THEN                         # BAD SYNTAX #
          BEGIN  # EXIT #
          BLMSG$LN[0] = MSG$SYNER;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END  # EXIT #
 
#
*      STORE M862 DEVICE ADDRESS AND SET EXISTENCE FLAG.
#
 
        UD$CUDA[1] = TMPI;
        UD$EXIST[1] = TRUE;
        SCOL = SCOL + 1;
        DEVTYPE = "CH";
        NUMCH = 2;
        LOOPC = FALSE;
        SLOWFOR J = 1 STEP 1 WHILE ( NOT LOOPC )
        DO
          BEGIN
          NEXTPRM(DIRLINE,SCOL,DEVTYPE,  ##
            NUMCH,ORD,NCOL,STAT,TERMINATOR);
 
#
*     INSERT *CH* DATA INTO BUDT
#
 
          IF ( ORD EQ 0 ) AND ( J NQ 1 ) AND ( STAT NQ 2 )
          THEN
            BEGIN
            BLMSG$LN[0] = " RDSUDT - CHANNEL 0 NOT FIRST CHANNEL.";
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S PFP AND ABORT #
            END
 
          IF ( STAT NQ 2 ) AND ( J EQ 1 )
          THEN
            BEGIN
            UD$CHANA[1] = ORD;
            UD$CHEX0[1] = TRUE;
            IF STAT EQ 1
            THEN
              BEGIN
              UD$CHANA$O[1] = TRUE;
              END
 
            ELSE
              BEGIN
              UD$CHANA$O[1] = FALSE;
              END
 
            END
 
          IF ( STAT EQ 2 ) AND ( J EQ 1 )
          THEN
            BEGIN
            UD$CHANA[1] = 0;
            UD$CHANA$O[1] = FALSE;
            END
 
          IF ( STAT NQ 2 ) AND ( J EQ 2 )
          THEN
            BEGIN
            UD$CHANB[1] = ORD;
            UD$CHEX1[1] = TRUE;
            IF STAT EQ 1
            THEN
              BEGIN
              UD$CHANB$O[1] = TRUE;
              END
 
            ELSE
              BEGIN
              UD$CHANB$O[1] = FALSE;
              END
 
            END
 
          IF ( STAT EQ 2 ) AND ( J EQ 2 )
          THEN
            BEGIN
            UD$CHANB[1] = 0;
            UD$CHANB$O[1] = FALSE;
            END
 
          IF ( STAT NQ 2 ) AND ( J EQ 3 )
          THEN
            BEGIN
            UD$CHANC[1] = ORD;
            UD$CHEX2[1] = TRUE;
            IF STAT EQ 1
            THEN
              BEGIN
              UD$CHANC$O[1] = TRUE;
              END
 
            ELSE
              BEGIN
              UD$CHANC$O[1] = FALSE;
              END
 
            END
 
          IF ( STAT EQ 2 ) AND ( J EQ 3 )
          THEN
            BEGIN
            UD$CHANC[1] = 0;
            UD$CHANC$O[1] = FALSE;
            END
 
          IF ( STAT NQ 2 ) AND ( J EQ 4 )
          THEN
            BEGIN
            UD$CHAND[1] = ORD;
            UD$CHEX3[1] = TRUE;
            IF STAT EQ 1
            THEN
              BEGIN
              UD$CHAND$O[1] = TRUE;
              END
 
            ELSE
              BEGIN
              UD$CHAND$O[1] = FALSE;
              END
 
            END
 
          IF ( STAT EQ 2 ) AND ( J EQ 4 )
          THEN
            BEGIN
            UD$CHAND[1] = 0;
            UD$CHAND$O[1] = FALSE;
            END
 
          IF TERMINATOR EQ PERIOD
          THEN
            BEGIN
            LOOPC = TRUE;
            TEST J;
            END
 
          IF J GR MAX$CH
          THEN
            BEGIN
            BLMSG$LN[0] =            ##
              "RDSUDT - MISSING CHANNELS ON *CU* COMMAND.";
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);
            END
 
          SCOL = NCOL;
          TEST J;
          END
 
        TEST DIRNUM;
 
CHANIF:
        IF( ARGKEY2 NQ NM$KEY2[2] ) AND (ARGKEY3 NQ "   ")
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BDORD;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        ARGKEY3 = NM$KEY3[3];
 
        STAT = XDXB(C<3,1>DIRLINE,0,TMPI);
        IF STAT NQ 0
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADADR;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF TMPI LS 0 OR TMPI GR 3
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADADR;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF C<4,1>DIRLINE NQ "="
        THEN
          BEGIN
          BLMSG$LN[0] = " RDSUDT - *CIF* COMMAND MISSING = SIGN.";
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        SCOL = 5;
        DEVTYPE = NM$KEY3[4];
        NUMCH = 3;
        LOOPC = FALSE;
        SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
        DO
          BEGIN
          NEXTPRM( DIRLINE,SCOL,DEVTYPE,  ##
            NUMCH,ORD,NCOL,STAT,TERMINATOR );
          IF STAT NQ 2
          THEN
            BEGIN
 
#
*      CHECK FOR VALID CHANNELS AND CIF LASHUPS.
#
 
            IF ( ( TMPI EQ 0 )       ##
              AND ( UD$CHANA[1] EQ 0 )  ##
              AND ( UD$CHANB[1] NQ 0 ) )  ##
              OR ( ( TMPI EQ 1 )     ##
              AND ( UD$CHANB[1] EQ 0 ) )  ##
              OR ( ( TMPI EQ 2 )     ##
              AND ( UD$CHANC[1] EQ 0 ) )  ##
              OR ( ( TMPI EQ 3 )     ##
              AND ( UD$CHAND[1] EQ 0 ) )  ##
            THEN
              BEGIN
              BLMSG$LN[0]= " RDSUDT - CH/CIF CONFLICT. ";
              MESSAGE ( BLMSG[0] , SYSUDF1)  ##
                ;
              RESTPFP ( PFP$ABORT );  # RESTORE USER-S PFP AND ABORT #
              END
 
            CIFI ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 );
            END
 
          IF STAT EQ 1
          THEN
            BEGIN
            CIFI ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 );
            END
 
          IF TERMINATOR EQ PERIOD
          THEN
            BEGIN
            LOOPC = TRUE;
            TEST J;
            END
 
          IF J EQ MAX$DTI
          THEN
            BEGIN
            LOOPC = TRUE;
            TEST J;
            END
 
          SCOL = NCOL;
          END
 
        SCOL = NCOL;
 
        DEVTYPE = NM$KEY3[5];
        LOOPC = FALSE;
        SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
        DO
          BEGIN
          NEXTPRM( DIRLINE,SCOL,DEVTYPE,  ##
            NUMCH,ORD,NCOL,STAT,TERMINATOR );
          IF STAT NQ 2
          THEN
            BEGIN
 
#
*      CHECK FOR VALID CHANNELS AND CIF LASHUPS.
#
 
            IF ( ( TMPI EQ 0 )       ##
              AND ( UD$CHANA[1] EQ 0 )  ##
              AND ( UD$CHANB[1] NQ 0 ) )  ##
              OR ( ( TMPI EQ 1 )     ##
              AND ( UD$CHANB[1] EQ 0 ) )  ##
              OR ( ( TMPI EQ 2 )     ##
              AND ( UD$CHANC[1] EQ 0 ) )  ##
              OR ( ( TMPI EQ 3 )     ##
              AND ( UD$CHAND[1] EQ 0 ) )  ##
            THEN
              BEGIN
              BLMSG$LN[0]= " RDSUDT - CH/CIF CONFLICT. ";
              MESSAGE ( BLMSG[0] , SYSUDF1);
              RESTPFP ( PFP$ABORT );  # RESTORE USER-S PFP AND ABORT #
              END
 
            CIFO ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 );
            END
 
          IF STAT EQ 1
          THEN
            BEGIN
            CIFO ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 );
            END
 
          IF TERMINATOR EQ PERIOD
          THEN
            BEGIN
            LOOPC = TRUE;
            TEST J;
            END
 
          IF J EQ MAX$DTO
          THEN
            BEGIN
            LOOPC = TRUE;
            TEST J;
            END
 
          SCOL = NCOL;
          END
 
        TEST DIRNUM;
 
DEVICETI:
        IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[3] )
          THEN
          BEGIN
          BLMSG$LN[0] = MSG$BDORD;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        ARGKEY3 = NM$KEY3[4];
 
        STAT = XDXB(C<3,1>DIRLINE,0,TMPI);
        IF STAT NQ 0
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADADR;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF TMPI LS 0 OR TMPI GR 1
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADADR;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF C<4,1>DIRLINE NQ "="
        THEN
          BEGIN
          BLMSG$LN[0] = " RDSUDT - *DTI* COMMAND MISSING = SIGN.";
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        SCOL = 5;
        DEVTYPE = NM$KEY3[6];
        NUMCH = 3;
        LOOPC = FALSE;
        SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
        DO
          BEGIN
          NEXTPRM( DIRLINE,SCOL,DEVTYPE,  ##
            NUMCH,ORD,NCOL,STAT,TERMINATOR );
          IF STAT NQ 2
          THEN
            BEGIN
            DTI01 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 );
            END
 
          IF STAT EQ 1
          THEN
            BEGIN
            DTI01 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 );
            END
 
          IF TERMINATOR EQ PERIOD
          THEN
            BEGIN
            LOOPC = TRUE;
            TEST J;
            END
 
          IF J GR MAX$DIF
          THEN
            BEGIN
            BLMSG$LN[0] = MSG$BADENT;
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S PFP AND ABORT #
            END
 
          SCOL = NCOL;
          END
 
        TEST DIRNUM;
DEVICETO:
        IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[4] )
          THEN
          BEGIN
          BLMSG$LN[0] = MSG$BDORD;
          MESSAGE( BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        ARGKEY3 = NM$KEY3[5];
 
        STAT = XDXB(C<3,1>DIRLINE,0,TMPI);
        IF STAT NQ 0
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADADR;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF TMPI LS 0 OR TMPI GR 1
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADADR;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF C<4,1>DIRLINE NQ "="
        THEN
          BEGIN
          BLMSG$LN[0] = " RDSUDT - *DTO* COMMAND MISSING = SIGN.";
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        SCOL = 5;
        DEVTYPE = NM$KEY3[6];
        NUMCH = 3;
        LOOPC = FALSE;
        SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
        DO
          BEGIN
          NEXTPRM( DIRLINE,SCOL,DEVTYPE,  ##
            NUMCH,ORD,NCOL,STAT,TERMINATOR );
          IF STAT NQ 2
          THEN
            BEGIN
            DTO01 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 );
            END
 
          IF STAT EQ 1
          THEN
            BEGIN
            DTO01 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 );
            END
 
          IF TERMINATOR EQ PERIOD
          THEN
            BEGIN
            LOOPC = TRUE;
            TEST J;
            END
 
          IF J GR MAX$DIF
          THEN
            BEGIN
            BLMSG$LN[0] = MSG$BADENT;
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S PFP AND ABORT #
            END
 
          SCOL = NCOL;
          END
 
        TEST DIRNUM;
DEVICEIF:
        IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[5] )
          THEN
          BEGIN
          BLMSG$LN[0] = MSG$BDORD;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        ARGKEY3 = NM$KEY3[6];
 
        STAT = XDXB(C<3,1>DIRLINE,0,TMPI);
        IF STAT NQ 0
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADADR;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF TMPI LS 0 OR TMPI GR 1
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADEST;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF C<4,1>DIRLINE NQ "="
        THEN
          BEGIN
          BLMSG$LN[0] = " RDSUDT - *DIF* COMMAND MISSING = SIGN.";
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        SCOL = 5;
        DEVTYPE = NM$KEY3[7];
        NUMCH = 3;
        LOOPC = FALSE;
        SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
        DO
          BEGIN
          NEXTPRM( DIRLINE,SCOL,DEVTYPE,  ##
            NUMCH,ORD,NCOL,STAT,TERMINATOR );
          IF STAT NQ 2
          THEN
            BEGIN
            DIF01 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 );
            END
 
          IF STAT EQ 1
          THEN
            BEGIN
            DIF01 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 );
            END
 
          IF TERMINATOR EQ PERIOD
          THEN
            BEGIN
            LOOPC = TRUE;
            TEST J;
            END
 
          IF J GR MAX$DRC
          THEN
            BEGIN
            BLMSG$LN[0] = MSG$BADENT;
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S PFP AND ABORT #
            END
 
          SCOL = NCOL;
          END
 
        TEST DIRNUM;
DATARC:
        IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[6] )
          THEN
          BEGIN
          BLMSG$LN[0] = MSG$BDORD;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        ARGKEY3 = NM$KEY3[7];
 
        STAT = XDXB(C<3,1>DIRLINE,0,TMPI);
        IF STAT NQ 0
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADEST;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF TMPI LS 0
          OR TMPI GR MAX$DRC
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADEST;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF C<4,1>DIRLINE NQ "="
        THEN
          BEGIN
          BLMSG$LN[0] = " RDSUDT - *DRC* ENTRY MISSING = SIGN.";
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        SCOL = 5;
        DEVTYPE = NM$KEY3[8];
        NUMCH = 3;
        LOOPC = FALSE;
        SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
        DO
          BEGIN
          NEXTPRM( DIRLINE,SCOL,DEVTYPE,  ##
            NUMCH,ORD,NCOL,STAT,TERMINATOR );
          IF STAT NQ 2
          THEN
            BEGIN
            IF ((TMPI LQ 1) AND (ORD GR MAX$DRD))
                                     # DRCS 0/1 ONLY GO TO DRDS 0-7 #
              OR ((TMPI GQ 2) AND (ORD LQ MAX$DRD))
                                     # DRC 2/3 ONLY GO TO DRDS 8-15 #
            THEN                     # DRC-DRD PATHS NOT CORRECT #
              BEGIN
              BLMSG$LN[0] = MSG$BADADR;
              MESSAGE(BLMSG[0],SYSUDF1);
              RESTPFP(PFP$ABORT);
              END
 
            IF TMPI EQ 0
            THEN
              BEGIN
              DRC00 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 );
              END
 
            IF TMPI EQ 1
            THEN
              BEGIN
              DRC01 ( 1 , TMPI , ORD , PATH$DF"U$EXISTS" , 1 );
              END
 
            IF TMPI EQ 2
            THEN
              BEGIN
              DRC02  ( 1, TMPI, ORD, PATH$DF"U$EXISTS", 1);
              END
 
            IF TMPI EQ 3
            THEN
              BEGIN
              DRC03 ( 1, TMPI, ORD, PATH$DF"U$EXISTS", 1);
              END
 
            END
 
          IF STAT EQ 1
          THEN
            BEGIN
            IF TMPI EQ 0
            THEN
              BEGIN
              DRC00 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 );
              END
 
          IF TMPI EQ 1
          THEN
              BEGIN
              DRC01 ( 1 , TMPI , ORD , PATH$DF"U$ON" , 1 );
              END
 
          IF TMPI EQ 2
          THEN
            BEGIN
            DRC02 ( 1, TMPI, ORD, PATH$DF"U$ON", 1 );
            END
 
          IF TMPI EQ 3
          THEN
            BEGIN
            DRC03 ( 1, TMPI, ORD, PATH$DF"U$ON", 1 );
             END
 
            END
 
          IF J GR MAX$DRD
          THEN
            BEGIN
            BLMSG$LN[0] = MSG$BADENT;
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S PFP AND ABORT #
            END
 
          IF TERMINATOR EQ PERIOD
          THEN
            BEGIN
            LOOPC = TRUE;
            TEST J;
            END
 
          SCOL = NCOL;
          END
 
        TEST DIRNUM;
 
ACCIF:
        IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[7] )
          THEN
          BEGIN
          BLMSG$LN[0] = MSG$BDORD;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        ARGKEY3 = NM$KEY3[9];
 
        STAT = XDXB(C<3,1>DIRLINE,0,TMPI);
        IF STAT NQ 0
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADADR;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF TMPI LS 0 OR TMPI GR 1
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADEST;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF C<4,1>DIRLINE NQ "="
        THEN
          BEGIN
          BLMSG$LN[0] = " RDSUDT - *AIF* ENTRY MISSING = SIGN.";
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        SCOL = 5;
        DEVTYPE = NM$KEY2[10];
        NUMCH = 2;
        LOOPC = FALSE;
        SLOWFOR J = 0 STEP 1 WHILE ( NOT LOOPC )
        DO
          BEGIN
          NEXTPRM( DIRLINE,SCOL,DEVTYPE,  ##
            NUMCH,ORD,NCOL,STAT,TERMINATOR );
          IF STAT NQ 2
          THEN                       # AIF PATH EXISTS #
            BEGIN  # EXISTS #
            IF TMPI EQ 0
            THEN                     # AIF0 PATH #
              BEGIN  # AIF0 #
              AIF0(1,ORD,PATH$DF"U$EXISTS",ON);
              END  # AIF0 #
 
            ELSE                     # AIF1 PATH #
              BEGIN  # AIF1 #
              AIF1(1,ORD,PATH$DF"U$EXISTS",ON);
              END  # AIF1 #
 
            END  # EXISTS #
 
          IF STAT EQ 1
          THEN                       # AIF PATH TURNED ON #
            BEGIN  # ON #
            IF TMPI EQ 0
            THEN                     # AIF0 PATH #
              BEGIN  # AIF0 #
              AIF0(1,ORD,PATH$DF"U$ON",ON);
              END  # AIF0 #
 
            ELSE                     # AIF1 PATH #
              BEGIN  # AIF1 #
              AIF1(1,ORD,PATH$DF"U$ON",ON);
              END  # AIF1 #
 
            END  # ON #
 
          IF (UD$AIF003[1] NQ 0 AND UD$AIF047[1] NQ 0)  ##
            OR (UD$AIF103[1] NQ 0 AND UD$AIF147[1] NQ 0)
          THEN                       # AIF GOES TO BOTH SETS OF SM-S #
            BEGIN  # EXIT #
            BLMSG$LN[0] = MSG$INVAIF;
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);
            END  # EXIT #
 
          IF TERMINATOR EQ PERIOD
          THEN
            BEGIN
            LOOPC = TRUE;
            TEST J;
            END
 
          IF J GR MAX$AC
          THEN
            BEGIN
            BLMSG$LN[0] = MSG$BADENT;
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);      # RESTORE USER-S PFP AND ABORT #
            END
 
          SCOL = NCOL;
          END
 
        TEST DIRNUM;
 
M861SM:
        SMNUM = SMNUM + 1;
        P<UDT$SMA> = LOC(BL$UDT$M861[SMNUM]);
        IF ( ARGKEY2 NQ NM$KEY2[2] ) AND ( ARGKEY3 NQ NM$KEY3[9] )
          THEN
          BEGIN
          BLMSG$LN[0] = MSG$BDORD;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        ARGKEY2 = NM$KEY2[11];
 
        IF ( C<2,1>DIRLINE LS "A" ) OR ( C<2,1>DIRLINE GR "H" )
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADEST;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        SM$ID[1] = C<2,1>DIRLINE;
        SM$EXIST[1] = TRUE;
 
#
*     INITIALIZE DRD STAGE/DESTAGE DEFAULTS, SUBJECT TO LATER CHANGE
#
 
        SM$STNUM[1] = 2;
        SM$DSNUM[1] = 1;
        IF C<3,1>DIRLINE NQ "="
        THEN
          BEGIN
          BLMSG$LN[0] = " RDSUDT - *SM* ENTRY MISSING = SIGN.";
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF ( C<4,2>DIRLINE NQ "ON" ) AND ( C<4,3>DIRLINE NQ "OFF" )
          THEN
          BEGIN
          BLMSG$LN[0] = MSG$BDST;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF C<4,2>DIRLINE EQ "ON"
        THEN
          BEGIN
          SCOL = 6;
          SM$ON[1] = TRUE;
          END
 
        ELSE
          BEGIN
          SCOL = 7;
          END
 
        IF C<SCOL,1>DIRLINE NQ COMMA
        THEN
          BEGIN
          BLMSG$LN[0] = "RDSUDT - *SM* COMMAND MISSING COMMA.";
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        SCOL = SCOL +1;
        IF C<SCOL,2>DIRLINE NQ NM$KEY2[10]
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADST;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        SCOL = SCOL+2;
        CHAR1 = C<SCOL,1>DIRLINE;
        STAT = XDXB(CHAR1,0,ACCESSOR);
        IF STAT NQ 0
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADADR;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        IF ((ACCESSOR LS 0) OR (ACCESSOR GR 7))
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$BADADR;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        SCOL=SCOL+1;
        IF C<SCOL,1>DIRLINE NQ COMMA
        THEN
          BEGIN
          BLMSG$LN[0] = MSG$SYNER;
          MESSAGE(BLMSG[0],SYSUDF1);
          RESTPFP(PFP$ABORT);
          END
 
        SCOL = SCOL+1;
 
#
*     LINK M862-S WITH M861-S
#
 
        LOOPK = FALSE;
        SLOWFOR J = 1 STEP 1 WHILE NOT LOOPK
        DO
          BEGIN
          IF C<SCOL,1>DIRLINE EQ COMMA
          THEN
            BEGIN
            SCOL = SCOL+1;
            IF J GR MAX$SMCU
            THEN
              BEGIN
              LOOPK = TRUE;
              TEST J;
              END
 
            TEST J;
            END
 
          IF ( C<SCOL,2>DIRLINE NQ NM$KEY2[2] )  ##
            AND ( C<SCOL,3>DIRLINE NQ NM$KEY3[8] )
          THEN
            BEGIN
            BLMSG$LN[0] = MSG$STCON;
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);
            END
 
          IF C<SCOL,3>DIRLINE EQ NM$KEY3[8]
          THEN
            BEGIN
            LOOPK = TRUE;
            TEST J;
            END
 
          IF J GR MAX$SMCU
          THEN
            BEGIN
            BLMSG$LN[0] = MSG$BADENT;
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);
            END
 
 
          SCOL = SCOL+2;
          CHAR3 = C<SCOL,3>DIRLINE;
          STAT = XDXB(CHAR3,0,ORD);  # ASSUME 3-CHARACTER CU ORDINAL #
          IF STAT NQ 0
          THEN
            BEGIN
            CHAR2 = C<SCOL,2>DIRLINE;
            STAT = XDXB(CHAR2,0,ORD);  # ASSUME 2-CHARACTER CU ORDINAL #
            SCOL = SCOL + 2;
            IF STAT NQ 0
            THEN                     # BAD CONTROLLER ORDINAL #
              BEGIN  # EXIT #
              BLMSG$LN[0] = MSG$BADADR;
              MESSAGE(BLMSG[0],SYSUDF1);
              RESTPFP(PFP$ABORT);
              END  # EXIT #
 
            END
 
          ELSE                       # BUMP POSITION COUNTER #
            BEGIN  # BUMP #
            SCOL = SCOL + 3;
            END  # BUMP #
 
          IF C<SCOL,1>DIRLINE NQ COMMA
          THEN                       # BAD SYNTAX #
            BEGIN  # EXIT #
            BLMSG$LN[0] = MSG$SYNER;
            MESSAGE(BLMSG[0],SYSUDF1);
            RESTPFP(PFP$ABORT);
            END  # EXIT #
 
            SCOL = SCOL + 1;
          LOOPC = FALSE;
          SLOWFOR K = 1 STEP 1 WHILE NOT LOOPC
          DO
            BEGIN
            P<UDT$CN> = LOC(BL$UDT$M862[K]);
            IF UD$ESTO[1] NQ ORD
            THEN
              BEGIN
              IF K GQ MAXCTN
              THEN
                BEGIN
                BLMSG$LN[0] = MSG$STCON;
                MESSAGE(BLMSG[0],SYSUDF1);
                RESTPFP(PFP$ABORT);
                END
 
              END
 
            IF UD$ESTO[1] EQ ORD
            THEN
              BEGIN
              LOOPC = TRUE;
              TEST K;
              END
 
            TEST K;
            END
 
#
*     INSERT ACCESSOR DEVICE ADDRESS INTO M861 TABLE
#
 
          SM$SUN[1] = ACCESSOR;
 
#
*     MOVE ACCESSOR LINKAGE TO M861 TABLE
#
 
          K = K-1;
          IF ( SM$STS0[1] NQ 0 )  ##
            AND ( SM$STS1[1] NQ 0 )
          THEN
            BEGIN
            BLMSG$LN[0] = MSG$EXPATH;
            MESSAGE(BLMSG[0],SYSUDF1);  # ERROR IN CONFIGURATION FILE #
            RESTPFP(PFP$ABORT);
            END
 
          IF B<(ACCESSOR*6)+PATH$DF"U$EXISTS",1>UD$AIF0[1] EQ ON
          THEN                       # AIF-AC PATH FOUND #
            BEGIN  # SM #
            B<ACCESSOR*6,6>UD$SMAIF[1] = SMNUM;  # LINK SM TO CU #
            END  # SM #
 
          IF B<(ACCESSOR*6)+PATH$DF"U$EXISTS",1>UD$AIF1[1] EQ ON
          THEN                       # AIF-AC PATH FOUND #
            BEGIN  # SM #
            B<ACCESSOR*6,6>UD$SMAIF[1] = SMNUM;  # LINK SM TO CU #
            END  # SM #
 
          IF SM$STS0[1] EQ 0
          THEN
            BEGIN
            SM$STS0[1] = SM$FLAG[1];
            SM$CUO0[1] = K;
            TEST J;
            END
 
          IF SM$STS1[1] EQ 0
          THEN
            BEGIN
            SM$STS1[1] = SM$FLAG[1];
            SM$CUO1[1] = K;
            TEST J;
            END
 
 
          END  # TEST J #
 
#
*     NOW CRACK DRD COMMANDS
#
 
        DEVTYPE = NM$KEY3[8];
        NUMCH = 3;
        LOOPK = FALSE;
        SLOWFOR J = 0 STEP 1 WHILE NOT LOOPK
        DO
          BEGIN
          NEXTPRM( DIRLINE,SCOL,DEVTYPE,  ##
            NUMCH,ORD,NCOL,STAT,TERMINATOR);
          SAVEDORD = ORD;            # IN CASE DRD IS 8-15 #
          IF ORD GR MAX$DRD
          THEN                       # ALLOW FOR FULL CONFIGURATION #
            BEGIN
            ORD = ORD - MAX$DRD - 1;
            END
 
          IF STAT NQ 2
          THEN
            BEGIN
            SMDRD ( 1 , ORD , PATH$DF"U$EXISTS" , 1 );
 
 
#
*     VALIDATE ACCESSOR AND DRD DEVICE ADDRESSES
#
 
            IF ( ( ACCESSOR EQ 0 )   ##
              AND ( ORD GR 1 ) )     ##
              OR ( ( ACCESSOR EQ 1 )  ##
              AND ( ORD LS 2 OR ORD GR 3 ) )  ##
              OR ( ( ACCESSOR EQ 2 )  ##
              AND ( ORD LS 4 OR ORD GR 5 ) )  ##
              OR ( ( ACCESSOR EQ 3 )  ##
              AND ( ORD LS 6 ) )     ##
            THEN
              BEGIN
              BLMSG$LN[0] = MSG$BADADR;
              MESSAGE ( BLMSG[0] , SYSUDF1 )  ##
                ;
              RESTPFP ( PFP$ABORT );
              END
 
#
*      ASSOCIATE EVEN NUMBERED DRD-S WITH FIRST POSITION IN TABLE
#
 
            IF ( ORD EQ 0 )          ##
              OR ( ORD EQ 2 )        ##
              OR ( ORD EQ 4 )        ##
              OR ( ORD EQ 6 )        ##
            THEN
              BEGIN
              D0$SUN[1] = SAVEDORD;  # STORE TRUE NUMBER #
              END
 
            ELSE
              BEGIN
              D1$SUN[1] = SAVEDORD;  # STORE TRUE NUMBER #
              END
 
            END
 
          IF STAT EQ 2
          THEN
            BEGIN
            SCOL = NCOL;
            TEST J;
            END
 
 
          IF STAT EQ 1
          THEN
            BEGIN
            SMDRD ( 1 , ORD , PATH$DF"U$ON" , 1 );
            END
 
 
          IF TERMINATOR EQ PERIOD
          THEN
            BEGIN
            LOOPK = TRUE;
            TEST J;
            END
 
          IF J GQ MAX$SMDRD - 1
          THEN
            BEGIN  # SEARCH FOR DESTAGE AND STAGE PARAMETERS #
            SCOL = NCOL;
 
#
*     CHECK FOR STAGE/DESTAGE DRD PARAMETERS
#
 
            IF C<SCOL,3>DIRLINE NQ "DS="
            THEN
              BEGIN  # ERROR IN STATMENT #
              BLMSG$LN[0] = MSG$SM$DS;
              MESSAGE(BLMSG[0],SYSUDF1);
              RESTPFP(PFP$ABORT);
              END  # ERROR IN STATEMENT #
 
            SCOL = SCOL + 3;
            CHAR1 = C<SCOL,1>DIRLINE;  # GET NUMBER OF DESTAGING DRDS #
            STAT = XDXB(CHAR1,0,TMPI);
            IF STAT NQ 0
            THEN
              BEGIN  # NOT A NUMBER #
              BLMSG$LN[0] = MSG$SM$DS;
              MESSAGE(BLMSG[0],SYSUDF1);
              RESTPFP(PFP$ABORT);
              END  # NOT A NUMBER #
 
            IF TMPI LS 1  ##
              OR TMPI GR 2
            THEN
              BEGIN  # NUMBER OUT OF RANGE #
              BLMSG$LN[0] = MSG$SM$DS;
              MESSAGE(BLMSG[0],SYSUDF1);
              RESTPFP(PFP$ABORT);
              END  # NUMBER OUT OF RANGE #
 
            SM$DSNUM[1] = TMPI;      # NUMBER OF DRDS FOR DESTAGING #
            SCOL = SCOL + 1;
 
            IF C<SCOL,4>DIRLINE NQ ",ST="
            THEN
              BEGIN  # ERROR IN STATEMENT #
              BLMSG$LN[0] = MSG$SM$ST;
              MESSAGE(BLMSG[0],SYSUDF1);
              RESTPFP(PFP$ABORT);
              END  # ERROR IN STATEMENT #
 
            SCOL = SCOL + 4;
            CHAR1 = C<SCOL,1>DIRLINE;  # GET NUMBER OF STAGING DRDS  #
            STAT = XDXB(CHAR1,0,TMPI);
            IF STAT NQ 0
            THEN
              BEGIN  # NOT A NUMBER #
              BLMSG$LN[0] = MSG$SM$ST;
              MESSAGE(BLMSG[0],SYSUDF1);
              RESTPFP(PFP$ABORT);
              END  # NOT A NUMBER #
 
            IF TMPI LS 1  ##
              OR TMPI GR 2
            THEN
              BEGIN  # NUMBER OUT OF RANGE #
              BLMSG$LN[0] = MSG$SM$ST;
              MESSAGE(BLMSG[0],SYSUDF1);
              RESTPFP(PFP$ABORT);
              END  # NUMBER OUT OF RANGE #
 
            SM$STNUM[1] = TMPI;      # NUMBER OF DRDS FOR STAGING #
            LOOPK = TRUE;
            TEST J;
            END  # SEARCH FOR DESTAGE AND STAGE PARAMETERS #
 
          SCOL = NCOL;
          END  # TEST J #
 
#
*     MOVE DRC/DRD PATH STATUS TO DRD TABLE
#
 
#
*     NOTE:
*     IF THERE ARE TWO SEPERATE M862-S CONNECTED TO THE SAME M861 SM,
*     THEN THE SECOND M862 ( FROM THE START OF THE BUDT ) INTO THE SM
*     IS ( BY DEFINITION ) THE SECOND CU IN THE SM TABLE. HENCE, IT CAN
*     ONLY INTERFACE TO THE *STSS* PATH IN THE *DRD* TABLES.
#
        P<UDT$CN> = LOC(BL$UDT$M862[1]);
        IF SM$CNT0[1] NQ 0
        THEN
          BEGIN  # CU0/DRD LINKUP #
          IF D0$EXIST[1]
          THEN                       # UPPER DRD EXISTS #
            BEGIN  # UPPER #
            B<PATH$DF"U$EXISTS",1>D0$STSP[1] = 1;
            UPDRDST(D0$SUN[1],SM$CUO0[1]);
            END  # UPPER #
 
          IF D1$EXIST[1]
          THEN                       # LOWER DRD EXISTS #
            BEGIN  # LOWER #
            B<PATH$DF"U$EXISTS",1>D1$STSP[1] = 1;
            UPDRDST(D1$SUN[1],SM$CUO0[1]);
            END  # LOWER #
 
          END  # CU0/DRD LINKUP #
 
        IF SM$CNT1[1] NQ 0
        THEN
          BEGIN  # CU1/DRD LINKUP #
          IF D0$EXIST[1]
          THEN                       # UPPER DRD EXISTS #
            BEGIN  # UPPER #
            B<PATH$DF"U$EXISTS",1>D0$STSS[1] = 1;
            UPDRDST(D0$SUN[1],SM$CUO1[1]);
            END  # UPPER #
 
          IF D1$EXIST[1]
          THEN                       # LOWER DRD EXISTS #
            BEGIN  # LOWER #
            B<PATH$DF"U$EXISTS",1>D1$STSS[1] = 1;
            UPDRDST(D1$SUN[1],SM$CUO1[1]);
            END  # LOWER #
 
          END  # CU1/DRD LINKUP #
 
        TEST DIRNUM;
 
        END  # TEST DIRNUM #
 
      IF NUM$CU NQ CUNUM
      THEN
        BEGIN
        BLMSG$LN[0] = MSG$INCCU;
        MESSAGE(BLMSG[0],SYSUDF1);
        RESTPFP(PFP$ABORT);          # RESTORE USER-S PFP ANF^D ABORT #
        END
 
      IF NUM$SM NQ SMNUM
      THEN
        BEGIN
        BLMSG$LN[0] = MSG$INCSM;
        MESSAGE(BLMSG[0],SYSUDF1);
      RESTPFP(PFP$ABORT);            # RESTORE USER-S PFP AND ABORT #
        END
 
      RETERN(BL$FET[0],RCL);
      END  # RDSUDT #
 
    TERM
PROC NEXTLIN(DIRLINE,STAT,INDEX);
 
# TITLE NEXTLIN - READ NEXT LINE OF CONFIGURATION SOURCE FILE.        #
 
      BEGIN  # NEXTLIN #
 
 
#
***   PROC TO READ ONE LINE OF DATA FROM DATA ALREADY IN A FET.
*     *NEXTLIN* READS A LINE (WHICH IS AN *SSBLD* CONFIGURATION
*     FILE DIRECTIVE). THE PROC READS CARDS UNTIL IT FINDS ONE THAT
*     IS NOT A COMMENT CARD.  IT CHECKS FOR END OF RECORD AND
*     VALID CONFIGURATION FILE NMEMONIC.
*
*     ENTRY - NONE.
*
*     EXIT
*
*     DIRLINE = CONFIGURATION FILE IMAGE
*     STAT    = STATUS RESPONSE FROM *READC*
*     INDEX   = INDEX INTO NM$KEY ARRAY ( DIRECTIVE ORDINAL )
*
*     MESSAGES
*
*     NEXTLIN - INCORRECT SSBLD MNEMONIC.
*
#
 
#
*     PROC NEXTLIN - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC BZFILL;                 # BLANK ZERO FILL #
        PROC MESSAGE;                # ISSUE MESSAGE #
        PROC READC;                  # READ ONE LINE #
        PROC RESTPFP;                # RESTORE USER-S PFP #
        PROC ZFILL;                  # ZERO FILL PROC #
        END
 
#
*     PROC NEXTLIN - XREF LIST END.
#
 
      ITEM DIRLINE    C(90);         # DIRECTIVE TEXT LINE #
      ITEM STAT       I;             # RETURN STATUS #
      ITEM INDEX      I;             # ARRAY INDEX #
 
 
 
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBFET
*CALL COMBUDT
*CALL COMSPFM
*CALL COMTBLD
 
      ITEM COMMENT    B;             # COMMENT INDICATOR #
      ITEM EOR        B;             # STATUS VARIABLE FOR *READC* #
      ITEM I          I;             # LOOP VARIABLE #
      ITEM KEYOK      B;             # CONTROL VARIABLE #
      ITEM KEY2       C(2);          # 2 CHARACTER DIRECTIVE KEYWORD #
      ITEM KEY3       C(4);          # 3 CHARACTER DIRECTIVE KEYWORD #
      ITEM DIRNUM     I;             # LOOP INDEX #
                                               CONTROL EJECT;
 
#
*     READ ONE (NON-COMMENT) DIRECTIVE.
#
 
      EOR = FALSE;
 
      SLOWFOR DIRNUM = 1 STEP 1 WHILE NOT EOR
      DO
        BEGIN  # PROCESS NEXT DIRECTIVE #
        DIRLINE = " ";               # ERASE PREVIOUS LINE #
        READC(BL$FET[0],DIRLINE,9,STAT);
        BZFILL(DIRLINE,TYPFILL"BFILL",90);
        C<89,1>DIRLINE = PERIOD;
        IF STAT NQ 0
        THEN
          BEGIN
          EOR = TRUE;
          RETURN;
          END
 
        IF C<0,1>DIRLINE NQ "*"
        THEN                         # NOT COMMENT #
          BEGIN
          EOR = TRUE;
          TEST DIRNUM;
          BLMSG$LN=DIRNUM;
          MESSAGE(BLMSG[0],SYSUDF1);
          END
 
        TEST DIRNUM;
        END
 
      KEY2 = C<0,2>DIRLINE;
      KEY3 = C<0,3>DIRLINE;
      KEYOK = FALSE;
      SLOWFOR I=1 STEP 1 WHILE (NOT KEYOK) AND (I LQ BLLM)
      DO
        BEGIN
        IF ( KEY2 EQ NM$KEY2[1] )    ##
          OR ( KEY2 EQ NM$KEY2[2] )  ##
          OR ( KEY2 EQ NM$KEY2[10] )  ##
          OR ( KEY2 EQ NM$KEY2[11] )  ##
        THEN
          BEGIN
          IF KEY2 EQ NM$KEY2[I]
          THEN
            BEGIN
            INDEX=I-1;
            KEYOK = TRUE;
            TEST I;
            END
 
          END
 
        ELSE
          BEGIN
          IF KEY3 EQ NM$KEY3[I]
          THEN
            BEGIN
            INDEX = I-1;
            KEYOK = TRUE;
            TEST I;
            END
 
          END
 
        TEST I;
        END
 
      IF NOT KEYOK
      THEN
        BEGIN
        BLMSG$LN[0] = " NEXTLIN - INCORRECT SSBLD MNEMONIC.";
        MESSAGE(BLMSG[0],SYSUDF1);   # ERROR MESSAGE #
        RESTPFP(PFP$ABORT);          # RESTORE USER-S PFP AND ABORT #
        END
 
 
      END  # NEXTLIN #
 
    TERM
 
PROC NEXTPRM(DIRLINE,SCOL,DEVTYPE,NUMCH,ORD,NCOL,STAT,TERMINATOR);
 
# TITLE NEXTPRM - CRACK NEXT LINE OF SOURCE FILE DIRECTIVES.          #
 
      BEGIN  # NEXTPRM #
 
 
#
***   PROC TO CRACK EVERYTHING TO THE RIGHT OF THE FIRST *=* SIGN
*     IN A *SSBLD* SOURCE FILE DIRECTIVE.
*
*     ENTRY
*
*     DIRLINE = CONFIGURATION SOURCE FILE DIRECTIVE
*     SCOL    = COLUMN OF DIRECTIVE IN WHICH TO START SEARCH
*     DEVTYPE = NMEMONIC BEING SEARCHED FOR
*     NUMCH   = NUMBER OF CHARACTERS IN DEVTYPE
*
*     EXIT
*
*     ORD = ORDINAL OF DEVTYPE ON SOURCE LINE
*     NCOL = NUMBER OF THE NEXT COLUMN FOLLOWING TERMINATOR.
*     STAT = STATUS OF DEVTYPE IN THE DIRECTIVE ( ON/OFF/NON-EXISTEXT )
*     TERMINATOR = THE TERMINATOR FOUND ( EITHER *,* OR *.* )
*
*     MESSAGES
*
*     NEXTPRM - INCORRECT MNEMONIC.
*     NEXTPRM - ORDINAL INCORRECT.
*     NEXTPRM - INCORRECT DRD ORDINAL.
*     NEXTPRM - DRC DEVICE ADDRESS OUT OF RANGE.
*     NEXTPRM - INCORRECT CHANNEL NUMBER.
*     NEXTPRM - INCORRECT *SM* ORDINAL.
*     NEXTPRM - INCORRECT *CU* EST ORDINAL.
*     NEXTPRM - MISSING EQUAL SIGN.
*     NEXTPRM - INCORRECT DIRECTIVE STATUS.
*     NEXTPRM - INCORRECT TERMINATOR.
*
#
 
      ITEM DIRLINE    C(90);         # DIRECTIVE LINE INPUT #
      ITEM SCOL       I;             # STARTING COLUMN #
      ITEM DEVTYPE    C(3);          # DEVICE TYPE #
      ITEM NUMCH      I;             # NUMBER OF CHARACTERS #
      ITEM ORD        I;             # DEVTYPE ORDINAL #
      ITEM NCOL       I;             # NEXT COLUMN #
      ITEM STAT       I;             # STATUS
                                       -0=OFF,1=ON,2=NON-EXISTENT #
      ITEM TERMINATOR C(1);          # TERMINATING CHARACTER #
 
#
*     PROC NEXTPRM - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC MESSAGE;                # ISSUE MESSAGE #
        PROC RESTPFP;                # RESTORE USER-S PFP #
        FUNC XDXB;                   # CONVERT DISPLAY CODE TO BINARY #
        END
 
#
*     PROC NEXTPRM - XREF LIST END.
#
 
      DEF MSG$BADORD #" NEXTPRM - ORDINAL INCORRECT."#;
      DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #
*CALL COMBFAS
*CALL COMBUDT
*CALL COMTBLD
 
 
      ITEM LOOPC      B;             # LOOP CONTROL #
      ITEM I          I;             # LOOP INDEX #
      ITEM TMPC       C(2);          # CHARACTER SCRATCH CELL #
      ITEM TMPI       I;             # SCRATCH INTEGER #
                                               CONTROL EJECT;
 
#
*     GET NEXT NON-BLANK CHARACTER
#
 
      LOOPC = FALSE;
      SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC
      DO
        BEGIN
 
        IF C<SCOL,1>DIRLINE EQ " "
        THEN
          BEGIN
          SCOL = SCOL+1;
          TEST I;
          END
 
 
        LOOPC = TRUE;
        TEST I;
        END
 
#
*     CHECK DIRECTIVE NMEMONIC
#
 
      IF  ( C<SCOL,NUMCH>DIRLINE NQ C<0,NUMCH>DEVTYPE )  ##
        AND ( C<SCOL,1>DIRLINE NQ COMMA )  ##
        AND ( C<SCOL,1>DIRLINE NQ PERIOD )  ##
      THEN
        BEGIN
        BLMSG$LN[0] = " NEXTPRM - INCORRECT MNEMONIC.";
        GOTO ERRORPRM;
        END
 
#
*      CHECK FOR COMMA OR PERIOD( IMPLIES NON-EXISTENT ENTRY ).
#
 
      IF( C<SCOL,1>DIRLINE EQ COMMA )  ##
        OR ( C<SCOL,1>DIRLINE EQ PERIOD )
      THEN
        BEGIN
        STAT = 2;
        ORD = 0;
        GOTO TERMINATE;
        END
 
#
*     REMOVE EMBEDDED BLANKS
#
 
      SCOL = SCOL+NUMCH;
      LOOPC = FALSE;
      SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC
      DO
        BEGIN
        IF C<SCOL,1>DIRLINE EQ " "
        THEN
          BEGIN
          SCOL = SCOL+1;
          TEST I;
          END
 
        LOOPC = TRUE;
        TEST I;
        END
 
#
*     GET AND VALIDATE ORDINAL
#
 
 
      IF( C<0,NUMCH>DEVTYPE NQ NM$KEY2[2] )  ##
        AND ( C<0,NUMCH>DEVTYPE NQ NM$KEY2[10] )  ##
        AND ( C<0,NUMCH>DEVTYPE NQ NM$KEY2[1] )  ##
      THEN
        BEGIN
        TMPC = C<3,1>DIRLINE;
        STAT = XDXB(TMPC,1,ORD);
        IF C<0,3>DIRLINE EQ NM$KEY3[7]
          AND ORD GQ 2
        THEN
          BEGIN                      # EXPANDED DRD CONFIGURATION #
          TMPC = C<SCOL,1>DIRLINE;
          STAT = XDXB(TMPC,1,ORD);
          IF STAT NQ 0
          THEN
            BEGIN
            BLMSG$LN[0] = MSG$BADORD;
            GOTO ERRORPRM;
            END
 
          IF ORD EQ 1
          THEN
            BEGIN                    # DRD DEVICE ADDRESS IS 2 DIGITS #
            TMPC = C<SCOL,2>DIRLINE;
            STAT = XDXB(TMPC,1,ORD);
            IF STAT NQ 0
            THEN
              BEGIN
              BLMSG$LN[0] = MSG$BADORD;
              GOTO ERRORPRM;
              END
 
            SCOL = SCOL + 1;
            END                      # DRD DEVICE ADDRESS IS 2 DIGITS #
 
          END                        # EXPANDED DRD CONFIGURATION #
 
        ELSE
          BEGIN                      # STANDARD DRD CONFIGURATION #
          TMPC = C<SCOL+1,1>DIRLINE;
          STAT = XDXB(TMPC,1,ORD);
          IF STAT NQ 0
          THEN                       # ORDINAL IS 1 DIGIT LONG #
            BEGIN  # ONE #
            TMPC = C<SCOL,1>DIRLINE;
            END  # ONE #
 
          ELSE                       # ORDINAL IS 2 DIGITS LONG #
            BEGIN  # TWO #
            TMPC = C<SCOL,2>DIRLINE;
            SCOL = SCOL + 1;         # PRESET FOR NEXT CHARACTER #
            END  # TWO #
 
          STAT = XDXB(TMPC,1,ORD);   # GET DRD ORDINAL #
          IF STAT NQ 0
          THEN
            BEGIN
            BLMSG$LN[0] = MSG$BADORD;
            GOTO ERRORPRM;
            END
 
          END                       # STANDARD DRD CONFIGURATION #
 
        IF NUMCH EQ 3
        THEN
          BEGIN
          IF C<0,3>DEVTYPE EQ NM$KEY3[8]
          THEN
            BEGIN
          IF ( ORD LS 0 ) OR ( ORD GR MAX$DRDDA )
            THEN
              BEGIN
              BLMSG$LN[0] = " NEXTPRM - INCORRECT DRD ORDINAL.";
              GOTO ERRORPRM;
              END
 
            END
 
          END
 
        IF ( ( ORD LS 0 ) OR ( ORD GR MAX$DRC ) ) ##
          AND ( C<0,3>DEVTYPE NQ NM$KEY3[8] )
        THEN
          BEGIN
          BLMSG$LN[0] = " NEXTPRM - DRC DEVICE ADDRESS OUT OF RANGE.";
          GOTO ERRORPRM;
          END
 
        SCOL = SCOL+1;
 
        END
 
      ELSE
        BEGIN
        IF C<0,2>DEVTYPE EQ NM$KEY2[1]
        THEN
          BEGIN
          TMPC = C<SCOL,2>DIRLINE;
          STAT = XDXB(TMPC,0,ORD);
          IF STAT NQ 0
          THEN
            BEGIN
            BLMSG$LN[0] = MSG$BADORD;
            GOTO ERRORPRM;
            END
 
          IF (( ORD GR O"13" ) AND ( ORD LS O"20" ))  ##
            OR ( ORD GR O"33")
          THEN
            BEGIN
            BLMSG$LN[0] = " NEXTPRM - INCORRECT CHANNEL NUMBER.";
            GOTO ERRORPRM;
            END
 
          SCOL = SCOL+2;
          END
 
        IF C<0,2>DEVTYPE EQ NM$KEY2[10]
        THEN
          BEGIN
          TMPC = C<SCOL,1>DIRLINE;
          STAT = XDXB(TMPC,0,ORD);
          IF STAT NQ 0
          THEN
            BEGIN
            BLMSG$LN[0] = MSG$BADORD;
            GOTO ERRORPRM;
            END
 
          IF (ORD LS 0) OR (ORD GR 7)
          THEN
            BEGIN
            BLMSG$LN[0] = "NEXTPRM - INCORRECT *SM* ORDINAL.";
            GOTO ERRORPRM;
            END
 
          SCOL = SCOL+1;
          END
 
        IF C<0,2>DEVTYPE EQ NM$KEY2[2]
        THEN
          BEGIN
          TMPC = C<SCOL,2>DIRLINE;
          STAT = XDXB(TMPC,0,ORD);
          IF STAT NQ 0
          THEN
            BEGIN
            BLMSG$LN[0] = MSG$BADORD;
            GOTO ERRORPRM;
            END
 
          IF (ORD LS 10  ) OR ( ORD GR O"77" )
          THEN
            BEGIN
            BLMSG$LN[0] = " NEXTPRM - INCORRECT *CU* ORDINAL.";
            GOTO ERRORPRM;
            END
 
          SCOL = SCOL + 2;
          END
 
        IF ( C<0,2>DEVTYPE EQ "ON" )  ##
          OR ( C<0,3>DEVTYPE EQ "OFF" )
        THEN
          BEGIN
          GOTO TERMINATE;
          END
 
        END
 
#
*     FIND NEXT NON-BLANK CHARACTER
#
 
      LOOPC = FALSE;
      SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC
      DO
        BEGIN
        IF C<SCOL,1>DIRLINE EQ " "
        THEN
          BEGIN
          SCOL = SCOL + 1;
          TEST I;
          END
 
        LOOPC = TRUE;
        TEST I;
        END
 
      IF C<SCOL,1>DIRLINE NQ "="
      THEN
        BEGIN
        BLMSG$LN[0] = " NEXTPRM - MISSING EQUAL SIGN.";
        GOTO ERRORPRM;
        END
 
      SCOL = SCOL + 1;
 
#
*     FIND NEXT NON-BLANK CHARACTER
#
 
      LOOPC = FALSE;
      SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC
      DO
        BEGIN
        IF C<SCOL,1>DIRLINE EQ " "
        THEN
          BEGIN
          SCOL = SCOL +1;
          TEST I;
          END
 
        LOOPC = TRUE;
        TEST I;
        END
 
      IF( C<SCOL,2>DIRLINE NQ "ON" )  ##
        AND ( C<SCOL,3>DIRLINE NQ "OFF" )
      THEN
        BEGIN
        BLMSG$LN[0] = " NEXTPRM - INCORRECT DIRECTIVE STATUS.";
        GOTO ERRORPRM;
        END
 
      IF C<SCOL,2>DIRLINE EQ "ON"
      THEN
        BEGIN
        STAT = 1;
        SCOL = SCOL+2;
        END
 
      ELSE
        BEGIN
        STAT = 0;
        SCOL = SCOL + 3;
        END
 
 
TERMINATE:
 
      LOOPC = FALSE;
      SLOWFOR I = 1 STEP 1 WHILE NOT LOOPC
      DO
        BEGIN
        IF C<SCOL,1>DIRLINE EQ " "
        THEN
          BEGIN
          SCOL = SCOL + 1;
          TEST I;
          END
 
        LOOPC = TRUE;
        TEST I;
        END
 
      IF( C<SCOL,1>DIRLINE NQ COMMA )  ##
        AND ( C<SCOL,1>DIRLINE NQ PERIOD )
      THEN
        BEGIN
        BLMSG$LN[0] = " NEXTPRM - INCORRECT TERMINATOR.";
        GOTO ERRORPRM;
        END
 
      TERMINATOR = C<SCOL,1>DIRLINE;
      NCOL = SCOL+1;
      RETURN;
 
ERRORPRM:
      MESSAGE(BLMSG[0],SYSUDF1);
      RESTPFP(PFP$ABORT);
 
      END  # NEXTPRM #
 
    TERM
PROC UPDRDST(DRD,CONTORD);
 
# TITLE UPDRDST - UPDATE DRD STATUS ACCORDING TO PATH STATUS           #
 
      BEGIN  # UPDRDST #
 
#
***   UPDATE TRUE STATUS OF A DRD
*
*     THE TRUE STATUS OF A DRD (ON/OFF) AT INITIALIZATION
*     TIME DEPENDS ON THE STATUS OF THE PATHS LEADING TO
*     IT FROM THE DIF-S AND DRC-S.  IF ALL PATHS LEADING TO THE DRD
*     ARE OFF, THEN THIS PROC WILL SET THE INITIAL STATUS
*     OF THE DRD TO BE OFF REGARDLESS OF WHAT THE SSBLD
*     DIRECTIVE SAYS.
*
*     ENTRY      DRD = DRD ORDINAL.
*                CONTORD = CONTROLLER ORDINAL TO SCAN FOR PATH.
*
*     EXIT       DRD STATUS UPDATED IF NECESSARY.
*
*     MESSAGES   NONE.
#
 
      ITEM CONTORD    U;             # CONTROLLER ORDINAL #
      ITEM DRD        U;             # DRD NUMBER #
 
      DEF LISTCON  #0#;      # DO NOT LIST COMMON DECKS #
 
*CALL,COMBFAS
*CALL,COMBUDT
 
      ITEM FIRSTDRC   U;             # FIRST DRC TO SCAN FOR PATH #
      ITEM I          U;             # LOOP INDEX #
      ITEM J          U;             # LOOP INDEX #
 
                                                      CONTROL EJECT;
                                               CONTROL INERT;
 
#
*     ONLY DRC-S 0 AND 1 CAN CONNECT TO DRD-S 0-7.
*     ONLY DRC-S 2 AND 3 CAN CONNECT TO DRD-S 8-15.
#
 
      FIRSTDRC = 0;                  # ASSUME CHECKING DRC-S 0 AND 1 #
      IF DRD GQ 8
      THEN                           # DRD CONNECTED TO OTHER DRC PAIR #
        BEGIN  # RESET #
        FIRSTDRC = 2;                # CHECK DRC-S 2 AND 3 #
        END  # RESET #
 
#
*     SET THE PASSED DRD AS ON WITH RESPECT TO THE PASSED CONTROLLER
*     IF A DIF-DRC-DRD PATH CAN BE FOUND THAT IS ON FROM A
*     DIF IN THE PASSED CU TO THE PASSED DRD.
*
*     NOTE:  ALL CONTROLLERS ARE SEARCHED FOR A VALID DRC-DRD
*     PATH, SINCE DRC-S ARE INDEPENDENT OF THE CONTROLLERS
*     THEY RESIDE IN.
*
#
 
      SLOWFOR I = 1 STEP 1 UNTIL MAXCTN
      DO                             # SEARCH ALL CU-S FOR DRC-S #
        BEGIN  # CU #
        SLOWFOR J = FIRSTDRC STEP 1 UNTIL (FIRSTDRC + 1)
        DO                           # CHECK BOTH DRC-S  #
          BEGIN  # DRC #
          P<PTHSTAT> = LOC(UD$DRCP0[I]) + J;  # LOCATE DRC #
          IF PATHBIT(B<57,3>DRD,PATH$DF"U$EXISTS") EQ 1  ##
            AND PATHBIT(B<57,3>DRD,PATH$DF"U$ON") EQ 1  # DRC-DRD ON #
            AND ((B<J*6+PATH$DF"U$EXISTS",1>UD$DIF0[CONTORD] EQ 1  ##
            AND B<J*6+PATH$DF"U$ON",1>UD$DIF0[CONTORD] EQ 1)
                                     # DIF0-DRC PATH FOUND ON #
            OR (B<J*6+PATH$DF"U$EXISTS",1>UD$DIF1[CONTORD] EQ 1  ##
            AND B<J*6+PATH$DF"U$ON",1>UD$DIF1[CONTORD] EQ 1))
                                     # DIF1-DRC PATH FOUND ON #
          THEN                       # DRD CONFIRMED ON TO CONTROLLER #
            BEGIN  # DRD ON #
            IF CONTORD EQ SM$CUO0[1]
            THEN                     # SET DRD ON TO PRIMARY CU #
              BEGIN  # PRIMARY #
              IF B<59,1>DRD EQ 0 AND D0$ON[1]
              THEN                   # EVEN-NUMBERED DRD CHECKED #
                BEGIN  # EVEN #
                B<PATH$DF"U$ON",1>D0$STSP[1] = 1;
                END  # EVEN #
 
              IF B<59,1>DRD EQ 1 AND D1$ON[1]
              THEN                   # ODD-NUMBERED DRD CHECKED #
                BEGIN  # ODD #
                B<PATH$DF"U$ON",1>D1$STSP[1] = 1;
                END  # ODD #
 
              END  # PRIMARY #
 
            ELSE                     # SET DRD ON TO SECONDARY CU #
              BEGIN  # SECONDARY #
              IF B<59,1>DRD EQ 0 AND D0$ON[1]
              THEN                   # EVEN-NUMBERED DRD CHECKED #
                BEGIN  # EVEN #
                B<PATH$DF"U$ON",1>D0$STSS[1] = 1;
                END  # EVEN #
 
              IF B<59,1>DRD EQ 1 AND D1$ON[1]
              THEN                   # ODD-NUMBERED DRD CHECKED #
                BEGIN  # ODD #
                B<PATH$DF"U$ON",1>D1$STSS[1] = 1;
                END  # ODD #
 
              END  # SECONDARY #
 
            RETURN;                  # SEARCH COMPLETE #
            END  # DRD ON #
 
          END  # DRC #
 
        END  # CU #
 
                                               CONTROL REACTIVE;
 
      IF B<59,1>DRD EQ 0
      THEN                           # EVEN-NUMBERED DRD FOUND OFF #
        BEGIN  # OFF #
        D0$FLAG[1] = D0$STSP[1] LOR D0$STSS[1];  # IN CASE OFF TO BOTH #
        END  # OFF #
 
      ELSE                           # ODD-NUMBERED DRD FOUND OFF #
        BEGIN  # OFF #
        D1$FLAG[1] = D1$STSP[1] LOR D1$STSS[1];  # IN CASE OFF TO BOTH #
        END  # OFF #
 
                                               CONTROL INERT;
 
      END  # UPDRDST #
 
      TERM
PROC WTBUDT;
 
 
# TITLE WTBUDT - WRITE SSBLD GENERATED UDT TO DISK FILE               #
 
      BEGIN  # WTBUDT #
 
#
***   WTBUDT - WRITE UDT TO PERMANENT FILE.
*
*     TWTBUDT WRITES THE SSBLD GENERATED UDT TO THE SSEXEC
*     ACCESSIBLE PERMANENT FILE. THE DEFAULT FLIE NAME IS *BUDT*.
*
*     PROC WTBUDT.
*
*     ENTRY - NONE.
*
*     EXIT - UDT WRITTEN TO THE PERMANENT FILE.
*
*     MESSAGES
*
*     WTBUDT - CIO ERROR.
*     WTBUDT - DEVICE FULL FOR UDT FILE.
*
*     NOTES
#
 
#
**** PROC WTBUDT - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC BZFILL;                 # BLANK OR ZERO FILL AN ITEM #
        PROC MESSAGE;                # DISPLAYS MESSAGE IN DAYFILE #
        PROC RESTPFP;                # RESTORE USER-S PFP AND ABORT #
        PROC RETERN;                  # RETURNS A FILE #
        PROC REWIND;                 # REWINDS A FILE #
        PROC WRITE;                  # WRITE DATA TO DISK #
        PROC WRITEF;                 # WRITE EOF ON DISK FILE #
        PROC WRITER;                 # WRITES EOR ON A FILE #
        PROC WRITEW;                 # DATA TRANSFER ROUTINE #
        PROC ZFILL;                  # ZERO FILLS A BUFFER #
        PROC ZSETFET;                # SETS UP A FET #
        END
 
#
****  PROC WTBUDT - XREF LIST END.
#
 
      DEF MSG$CIOERR  #"WTBUDT - CIO ERROR."#;
      DEF MSG$DSKFULL #"WTBUDT - DEVICE FULL FOR UDT FILE."#;
 
      DEF LISTCON    #0#;            # DO NOT LIST THE COMMON DECKS #
*CALL,COMBFAS
*CALL,COMBBZF
*CALL,COMBFET
*CALL,COMBUDT
*CALL,COMSPFM
*CALL,COMTBLD
*CALL,COMTBLP
*CALL,COMTOUT
 
      ITEM BUFP       I;             # FWA OF BUFFER #
      ITEM FETP       I;             # FET POINTER #
      ITEM TMPI       I;
      ITEM TMPJ       I;
      ITEM TMPK       I;
      ITEM LFN        C(7);          # FILE NAME #
      ITEM STAT       I;             # INTEGER STATUS VARIABLE #
 
                                               CONTROL EJECT;
 
#
*     SET UP THE FET FOR UDT BINARY AND REWIND IT.
#
 
      LFN = DARG$BF[0];
      BZFILL(LFN,TYPFILL"ZFILL",7);
      FETP = LOC(BL$FET[0]);
      BUFP = LOC(BL$BUF[0]);
      ZSETFET(FETP,LFN,BUFP,BLBUFL,SFETL);
      REWIND(BL$FET[0],RCL);
      P<BL$UDT$LOC> = LOC(BL$UDT$HDR);
 
#
*     WRITE THE FILE TO *CIO* BUFFER
#
 
      WRITEW(BL$FET[0],BL$UDT$LOC[0],LARCUDTLTM,STAT);
 
#
*     WRITE UDT TO DISK
#
 
      WRITE(BL$FET[0],RCL);
      WRITER(BL$FET[0],RCL);
      WRITEF(BL$FET[0],RCL);
      REWIND(BL$FET[0],RCL);
      RETERN(BL$FET[0],RCL);
 
      END  # WTBUDT #
 
    TERM