!JHB 5/6/85 changed .N & .TT to :n and :t respectively

%EXTERNALINTEGERFN DEF STREAMS(%STRING(127) PARMS, DEFAULTS)
   %RECORDFORMAT NAMEF(%INTEGER DEV, DIR, NAME, EXT, QUAL, END)
   %RECORD(NAMEF)%ARRAY STREAM(1:6),   DEFAULT(1:6)
   %STRING(127) NAME
   %INTEGER STREAMNO,   RESULT
   %CONST %STRING(31) ERROR="*Error: "

%ROUTINE PARSE(%STRING(127)%NAME S, %RECORD(NAMEF)%ARRAYNAME N(1:6))
   %INTEGER P, I, CH

   %ROUTINE SKIP BLANKS
      P=P+1 %WHILE P<=LENGTH(S) %AND CHARNO(S,P)=' '
   %END

   %INTEGERFN THIS CH
      %RESULT=0 %IF P>LENGTH(S)
      %RESULT=CHARNO(S,P)
   %END

   %ROUTINE SKIP TO(%STRING(15) TERMINATORS)
      %INTEGER T, CH
      %WHILE P<=LENGTH(S) %CYCLE
         CH=THIS CH
         %FOR T=1,1,LENGTH(TERMINATORS) %CYCLE
            %RETURN %IF CH=CHARNO(TERMINATORS,T)
         %REPEAT
         P=P+1
      %REPEAT
   %END

   %ROUTINE SKIP CH
      P=P+1 %IF P<=LENGTH(S)
   %END

   %ROUTINE GET(%RECORD(NAMEF)%NAME N)
      !! get a file name in all its glory
      SKIP BLANKS
      N_DEV=P;   N_DIR=P;   N_NAME=P
      SKIP TO(":.- ,[/")
{rwt}!%IF THIS CH=':' %START
{rwt}!   SKIP CH
{rwt}!   N_DEV=N_NAME
{rwt}!   N_DIR=P;   N_NAME=P
{rwt}!%FINISH
      %IF THIS CH='[' %START
         SKIP TO("]")
         SKIP CH
         N_NAME=P
      %FINISH
      SKIP TO(".- ,/")
      N_EXT=P
      %IF THIS CH='.' %THEN SKIP TO("- ,/")
      N_QUAL=P
      %IF THIS CH='-' %THEN SKIP TO(" ,/")
      N_END=P
      SKIP BLANKS
   %END

   !! start of PARSE
   P=1
!!pmm   CHARNO(S,LENGTH(S)+1)=NL;      !! for safety
   %FOR I=1,1,6 %CYCLE
      GET(N(I))
      %EXIT %IF I=6
      CH=THIS CH
      SKIP CH %IF (I=3 %AND CH='/') %OR (I#3 %AND CH=',')
   %REPEAT
%END

%STRING(127)%FN FILENAME(%RECORD(NAMEF)%NAME N, D)
   %CONSTINTEGER GOOD=0, BAD=-1
   %INTEGER DE, DN, CH, STR, FLAG
   %RECORD(NAMEF)%NAME REF
   %STRING(127) NAME

%ROUTINE ADD(%INTEGER S1, E1, S2, E2)
   !! build up the string NAME using substrings of PARMS and DEFAULTS
   !! S! and E1 refer to PARMS. DEFAULTS is used if S1=E1
   %IF E1>S1 %START
      NAME=NAME.SUBSTRING(PARMS,S1,E1-1)
   %FINISH %ELSE %IF E2>S2 %START
      NAME=NAME.SUBSTRING(DEFAULTS,S2,E2-1)
   %FINISH
%END

   !! start of FILENAME
   NAME="";   FLAG=GOOD
   ADD(N_DEV,N_DIR,D_DEV,D_DIR)
   ADD(N_DIR,N_NAME,D_DIR,D_NAME)
   %IF N_EXT>N_NAME %START
      !! got a filename specified, so use it
      NAME=NAME.SUBSTRING(PARMS,N_NAME,N_EXT-1)
      ->EXT AND QUAL
   %FINISH
   !! no filename, so things to sort out
   !! assume if only an extension then device meant
   %IF N_DEV=N_DIR=N_NAME %AND N_NAME=N_EXT %AND %C
       N_QUAL>N_DEV %AND N_QUAL=N_END %THEN ->EXT AND QUAL
   !! otherwise assume not a device
   DN=D_NAME;   DE=D_EXT
   ->NULL %IF DE<=DN
   !! got a default name
   ->NOREF %IF CHARNO(DEFAULTS,DN)#'%'
   !! and it references another stream name
   FLAG=BAD %AND ->NOREF %UNLESS DE-DN=3
   CH=CHARNO(DEFAULTS,DN+1)
   %IF CH='I' %START
      STR=0
   %FINISH %ELSE %IF CH='O' %START
      STR=3
   %FINISH %ELSE %START
      FLAG=BAD
      ->NOREF
   %FINISH
   CH=CHARNO(DEFAULTS,DN+2)-'0'
   FLAG=BAD %AND ->NOREF %UNLESS 0<CH<4
   REF==STREAM(STR+CH)
   ->NULL %UNLESS REF_EXT>REF_NAME
   NAME=NAME.SUBSTRING(PARMS,REF_NAME,REF_EXT-1)
   ->EXT AND QUAL
NOREF:
   !! not a reference to another stream
   NAME=NAME.SUBSTRING(DEFAULTS,DN,DE-1)
   ->EXT AND QUAL
NULL:
   !! null stream specified
   %IF STREAMNO=1 %OR STREAMNO=4 %THEN NAME=":T" %C
   %ELSE NAME=":N"
   ->OUT
EXT AND QUAL:
   ADD(N_EXT,N_QUAL,D_EXT,D_QUAL)
   ADD(N_QUAL,N_END,D_QUAL,D_END)
OUT:
   %IF FLAG=BAD %START
      !! bum filename or reference
      PRINTSTRING(ERROR.NAME." {invalid VMS file or device name}")
      NEWLINE
      NAME=""
   %FINISH
   %RESULT=NAME
%END

   !!  start of DEF STREAMS

   %ON %EVENT 3,9 %START
      PRINTSTRING(ERROR.NAME." {file not found}")
{jhb} event_message = error.name." {file not found}"
      NEWLINE
      %RESULT=16_18292
   %FINISH

   %IF PARMS="" %OR PARMS=" " %START
      SELECTOUTPUT(0)
      PRINTSTRING("Format is: <command> <inputs> / <outputs>")
      NEWLINE
      PRINTSTRING("Use HELP ESDL for further guidance")
      NEWLINE
      %RESULT=16_818
   %FINISH

   PARSE(PARMS,STREAM)
   PARSE(DEFAULTS,DEFAULT)

   RESULT=1
   %FOR STREAMNO=1,1,6 %CYCLE
      NAME=FILENAME(STREAM(STREAMNO),DEFAULT(STREAMNO))
      %IF LENGTH(NAME)=0 %START
         RESULT=16_818
      %FINISH %ELSE %START
         %if charno(name,1)=':' %and length(name)>1 %start
           length(name) = 2
           length(name) = 1 %if charno(name,2)='.'
         %finish
         %IF STREAMNO<4 %START
            OPENINPUT(STREAMNO,NAME)
         %FINISH %ELSE %START
            OPENOUTPUT(STREAMNO-3,NAME)
         %FINISH
      %FINISH
   %REPEAT
   %RESULT=RESULT
%END

%endoffile