SSBLD 
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
