*DECK DFINIT
USETEXT COMCBEG 
USETEXT COMDFRD 
PROC DFINIT((PI),(PPC),(PPNAME),PINT,ERR,NODIR);
# TITLE  DFINIT - INITIALIZE DIRECTIVE FILE.  # 
      BEGIN  # DFINIT # 
  
# 
**    DFINIT - DIRECTIVE FILE INITIALIZE. 
* 
*     DFINIT IS CALLED FROM MFLINK AND MFQUEUE TO 
*     INITIATE PROCESSING OF THE DIRECTIVE FILE.
* 
*     PROC    DFINIT
* 
*     ENTRY    PI = LFN OF DIRECTIVES FILE
*                 = 0 OR BLANKS IF NO FILE. 
*             PPC = DIRECTIVE PREFIX CHARACTER
*                 = 0 OR BLANKS IF NONE.
*          PPNAME = PROGRAM CALLING DFINIT. 
*           NODIR = TRUE, IF DIRECTIVES ARE OPTIONAL (MFQUEUE). 
* 
*     EXIT     PINT = INTERACTIVE MODE FLAG 
*                   = TRUE IF DIRECTIVES ARE TO BE READ FROM TERMINAL 
*                   = FALSE OTHERWISE.
*               ERR = TRUE IF ERROR DETECTED BY DFINIT, IN WHICH
*                     CASE MESSAGE HAS ALREADY BEEN ISSUED. 
*             NODIR = FALSE IF NODIR WAS TRUE ON ENTRY AND DIRECTIVES 
*                       ARE AVAILABLE.
* 
*     PROCESS   REMOVE TRAILING BLANKS FROM INPUT PARAMETERS. 
*               INITIALIZE VARIABLES. 
*               IF INPUT FILE:  
*                 IF TERMINAL FILE: 
*                   INT = TRUE
*                 ELSE: 
*                   READ NEXT DIRECTIVE FROM FILE 
*               ELSE: 
*                 READ NEXT CONTROL STATEMENT.
*               RETURN. 
* 
*     COPYRIGHT CONTROL DATA SYSTEMS INC. 1994. 
* 
*     J. P. KELLER              04/09/82
* 
* 
# 
  
      ITEM PI         C(7);        # INPUT LFN #
      ITEM PPC        C(7);        # PREFIX CHARACTER # 
      ITEM PPNAME     C(7);        # CALLING PROGRAM-S NAME # 
      ITEM PINT       B;           # INTERACTIVE FLAG # 
      ITEM ERR        B;           # ERROR FLAG # 
      ITEM NODIR      B;           # NO DIRECTIVE FILE FLAG # 
  
# 
****  PROC DFINIT - XREF LIST BEGIN.
# 
      XREF
        BEGIN 
        PROC DF$RDH;               # READ CODED LINE #
        PROC DF$RD;                # ISSUE READ TO PRIME BUFFER # 
        PROC DF$CON;               # CONNECT FILE TO TERMINAL # 
        PROC DF$POF;               # TURN NOS PROMPT OFF #
        PROC DF$RCS;               # READ CONTROL STATEMENT RECORD #
        PROC DF$RTB;               # REMOVE TRAILING BLANKS # 
        FUNC DF$STF   I;           # SET TERMINAL FILE #
        PROC DF$WTC;               # SEND MESSAGE TO TERMINAL # 
        PROC DF$ISM;               # ISSUE MESSAGE #
        END 
  
# 
****  PROC DFINIT - XREF LIST END.
# 
  
      ITEM JOT        B;           # JOB ORIGIN TYPE #
      ITEM J          I;
# 
*     ERROR MESSAGES
# 
      ARRAY INVDFN [0:0]  S(5); 
        BEGIN 
        ITEM WDONE      C(00,00,39) = 
          ["         - INVALID DIRECTIVE FILE NAME."];
        ITEM ZEROBYTE   I(03,54,06) = [0];
        ITEM ZEROWORD   I(04,00,60) = [0];
        END 
  
      ARRAY ENTDIR [0:0]  S(2); 
        BEGIN 
        ITEM WRD1       C(00,00,17) = [" ENTER DIRECTIVES"];
        ITEM ZBYTE      I(01,42,18) = [0];
        END 
  
      CONTROL EJECT;
      P<RA$ZERO> = 0; 
      RA$CSLW = 0;
      I = PI; 
      PC = PPC; 
      PNAME = PPNAME; 
      JOT = RA$JOT EQ 3;
      ERR = FALSE;
      EOF = FALSE;
      INT = FALSE;
      FIRST = FALSE;
      DIRREQ = TRUE;
      DFETFIRST = LOC(CIOBUF);
      DFETIN = DFETFIRST; 
      DFETOUT = DFETFIRST;
      DFETLIMIT = DFETFIRST + BUFLGTH + 1;
      OUFETFIRST = LOC(CIOOUT); 
      OUFETIN = OUFETFIRST; 
      OUFETOUT = OUFETFIRST;
      OUFETLIMIT = OUFETFIRST + BUFLGTH + 1;
      DF$RTB(I);
      DF$RTB(PC); 
      DF$RTB(PNAME);
      PROMPT = C<0,1>PC;
      IF I NQ 0 
      THEN
        BEGIN 
      CONTROL IFEQ OS$NOS;
        IF (C<0,1>I LS "A") OR (C<0,1>I GR "9") 
        THEN
          BEGIN 
          ERR = TRUE; 
          END 
      CONTROL ENDIF;
      CONTROL IFEQ OS$NOSBE;
        IF (C<0,1>I LS "A") OR (C<0,1>I GR "Z") 
        THEN
          BEGIN 
          ERR = TRUE; 
          END 
      CONTROL ENDIF;
  
        FOR J = 1 STEP 1 WHILE J LQ 6 AND B<J*6,6>I NQ 0 AND NOT ERR
        DO
          BEGIN 
          IF (C<J,1>I LS "A") OR (C<J,1>I GR "9") 
          THEN
            BEGIN 
            ERR = TRUE; 
            END 
  
          END 
  
        IF ERR
        THEN
          BEGIN 
          DF$ISM(INVDFN,OUFET,PNAME,INT); 
          EOF = TRUE; 
          RETURN; 
          END 
  
        DFETNAME = I; 
        IF DF$STF(DFET) EQ 0
        THEN
          BEGIN 
          INT = TRUE; 
          END 
  
        ELSE
          BEGIN 
          DFETIN = DFETFIRST; 
          DFETOUT = DFETFIRST;
          DF$RD(DFET);
          DF$RDH(DFET,DUM,ONE,EOF); 
          DFETOUT = DFETFIRST;
          IF EOF
          THEN
            BEGIN 
            ERR = TRUE; 
            END 
  
          END 
  
        END 
  
      ELSE
        BEGIN    # I EQ 0 # 
        DF$RCS(NXT,EOF);
        IF EOF
        THEN
          BEGIN 
          INT = JOT;
          ERR = NOT (INT OR NODIR); 
          END 
  
        ELSE
          BEGIN    # IF NOT EOF # 
          IF RA$CSFC EQ PROMPT
          THEN
            BEGIN 
            FIRST = TRUE; 
            END 
  
          ELSE
            BEGIN 
            DF$RCS(BKSP,DUM); 
            INT = JOT;
            ERR = NOT (INT OR NODIR); 
            END 
  
          END 
  
        IF INT
        THEN
          BEGIN 
          DFETNAME = INTDIRFILE;
          DF$CON(DFET); 
          DUM = DF$STF(DFET); 
          END 
  
        END 
  
      IF JOT
      THEN
        BEGIN 
        DF$POF; 
        DF$CON(OUFET);
        DUM = DF$STF(OUFET);
        IF INT
        THEN
          BEGIN 
          DIRREQ = NOT NODIR;      # DIRECTIVES REQUIRED ? #
          DF$WTC(ENTDIR,OUFET);    # MESSAGE - ENTER DIRECTIVES # 
          END 
  
        END 
  
      IF ERR
      THEN
        BEGIN 
        DF$ISM(NORDFD,OUFET,PNAME,INT); 
        END 
  
      ELSE
        BEGIN 
        IF NODIR
          AND (FIRST OR INT)
        THEN
          BEGIN 
          NODIR = FALSE;
          END 
  
        END 
  
      PINT = INT; 
      FSTCALL = TRUE; 
  
      RETURN; 
  
      END     # DFINIT #
      TERM
