*DECK S$GTDIR 
          IDENT  S$GTDIR
          TITLE  S$GTDIR -  GET LINE FROM DIRECTIVE FILE
          COMMENT  GET LINE FROM DIRECTIVE FILE 
  
          SST                ACCESS #OPE# 
  
          SPACE  4
**        S$GTDIR -  GET LINE FROM DIRECTIVE FILE 
* 
*     CALLING SEQUENCE: 
*         S$GTDIR(DIFILNAM, LINE, EOF, STATUS$NORML); 
* 
*     GIVEN:  
*         FILENAME = NAME OF DIRECTIVE FILE, C(7) FORMAT. 
*         LINE = VARIABLE TO HOLD LINE, C(100) FORMAT.
*         EOF = BOOLEAN VARIABLE. 
* 
*     DOES: 
*         IF AN END OF RECORD HAS BEEN ENCOUNTERED, 
*             SET EOF = TRUE. 
*         ELSE
*             SET EOF = FALSE, AND
*             SETS LINE = LINE FROM FILE. 
  
  
          ENTRY  S$GTDIR
 S$GTDIR  SUBR
          SX6    A1          SAVE ADDRESS OF PARAMETER LIST 
          SA6    SAVEA1 
  
*     STRIP BLANKS FROM FILE NAME 
  
          SA1    X1          10HFILENAME
          SA2    =10H 
          IX2    X1-X2
          IFTHEN X2=0        IF BLANK FILE NAME,
            SX1    =10HS$GTDIR-1   INTERNAL ERROR 
            CALL   S$ABORT         (DOES NOT RETURN)
            ENDIF.
          MX0    -6 
          SX2    1R 
 GTDIR1   BX3    -X0*X1      EXTRACT NEXT CHARACTER 
          BX1    X1-X2       TENTATIVELY ZERO OUT BLANK 
          LX0    6           SHIFT MASK TO NEXT POSITION
          LX2    6           SHIFT SINGLE BLANK TO NEXT POSITION
          SX3    X3-1R       COMPASS EXTRACTED CHAR. VS. BLANK
          ZR     X3,GTDIR1   IF BLANK, LOOP 
          LX2    -6 
          BX1    X2-X1       RESET ORIGINAL CHARACTER 
                             X1 = NEW FILE NAME, L.J., ZERO-FILLED
  
*     IF NEW FILE NAME, OPEN FILE 
  
          FETCH  FIT,LFN,X5 
          *USES  AX5,X7 
          IX0    X1-X5
          IFTHEN X0"0        IF NEW FILE NAME,
            FETCH  FIT,OC,X5   FETCH OPEN/CLOSE FLAG
            *USES  AX5,X7 
            SX0    X5-#OPE# 
            IFTHEN X0=0        IF OLD FILE STILL OPEN,
              SX1    =10HS$GTDIR-2   ISSUE INTERNAL ERROR 
              CALL   S$ABORT     (DOES NOT RETURN)
              ENDIF.
            STORE  FIT,LFN=X1  PUT NEW NAME IN FIT
            *USES  AX5,AX6,X7 
            SA2    =0LINPUT 
            IX0    X1-X2
            IFTHEN X0=0        IF NEW NAME IS *INPUT*,
              OPENM  FIT,INPUT,N       OPEN WITH NO REWIND
              *USES  ALL
            ELSE-              IF NEW NAME IS NOT *INPUT*,
              OPENM  FIT,INPUT,R       OPEN WITH REWIND 
              *USES  ALL
              ENDIF.
            ENDIF.
  
*      CHECK IF LINE IN DIR. FILE IS GREATER THAN 100 CHARS.
*     THEN ISSUE ERROR E$82 AND SET STATUS$NORML TO FALSE.
  
          FETCH  FIT,FL,X5
          *USES  AX5,X7 
          SX0    X5-101 
          IFTHEN X0\0        IF GT 100 CHAR 
            SA1  GTDIRA 
            CALL S$ERROR
            SA1  SAVEA1 
            SA5  X1+3        ADDR OF STATUS$NORML 
            MX6  0
            SA6  X5          STATUS$NORML:=FALSE
            EQ   S$GTDIR     ERROR ENCOUNTER,EXIT 
            ENDIF.
  
*     GET NEXT LINE 
  
          SA1    SAVEA1      X1 = ORIGINAL A1 
          SA2    X1+1        X2 = ADDRESS OF LINE 
          STORE  FIT,WSA=X2 
          *USES  AX5,AX6,X7 
          GET    FIT
          *USES  ALL
  
*     SET EOF = FALSE, AND EXIT 
  
          SA1    SAVEA1      X1 = ORIGINAL A1 
          SA2    X1+2        X2 = ADDRESS OF EOF
          MX6    0           FALSE
          SA6    X2          EOF := FALSE 
          EXIT
  
  
*     DATA EXIT:  CLOSE FILE, EOF := TRUE, EXIT 
  
 GTDIR2   BSS    1           (ENTRY WORD FROM RJ) 
          CLOSEM FIT,N
          *USES  ALL
          SA1    SAVEA1      X1 = ORIGINAL A1 
          SA2    X1+2        X2 = ADDRESS OF EOF
          SX6    1           TRUE 
          SA6    X2          EOF := TRUE
          EXIT
  
 E$82     EQU    82 
 GTDIRA   VFD    42/,18/GTDIRB
          VFD    42/,18/GTDIRC
          VFD    42/,18/GTDIRD
 GTDIRB   CON    E$82 
 GTDIRC   DATA   10H
 GTDIRD   DATA   0
  
FIT       FILE   BT=C,RT=Z,FL=100,DX=GTDIR2,DFC=3,EFC=3,FWB=BUF,BFS=LBUF
  
LBUF      EQU    101B 
BUF       BSS    LBUF        (SO CRM DOES NOT ALLOCATE BUFFER)
  
 SAVEA1   BSS    1           ORIGINAL A1
  
  
          END 
