	PROGRAM LET

	IMPLICIT INTEGER (A-Z)

	CHARACTER*128 DEVICE,DIRECTORY

	COMMON /SD_LOC/ DEVLEN,DIRLEN,DEVICE,DIRECTORY

	CHARACTER*64 NAME
	CHARACTER*128 PARAM
	CHARACTER*5 SGS_VERSION

	DATA EXITCODE / 1 /

	STATUS = LIB$GET_SYMBOL('PARAM',PARAM,PLEN)

	CALL LJUST(PARAM(1:PLEN),PLEN)

	PLEN = STR_LEN(PARAM(1:PLEN))

	IF (.NOT.STATUS .OR. PLEN.EQ.0) CALL ERROR(1)

	IF (PARAM(1:PLEN).EQ.'$') THEN
	    sgs_version = '3.1'
	    L = STR_LEN(SGS_VERSION)
	    CALL LIB$PUT_LINE('	 LET.EXE Version '//SGS_VERSION(1:L)//
	1							 ' ',,2)
	    CALL EXIT
	ENDIF

	COL = INDEX(PARAM(1:PLEN),'=')

	IF (COL.EQ.0 .OR. COL.EQ.1) CALL ERROR(1)

	NLEN = COL - 1

	CALL CHECK_LOGICAL(PARAM(1:COL-1),NAME,NLEN)

*	If 'name == ...' was specified (two equal signs), then skip the
*	'SHOW LOGICAL name' after this program exits.

	IF (PARAM(COL+1:COL+1).EQ.'=') THEN
	    COL = COL + 1
	    EXITCODE = '10000004'X	! Abort later, with no message
	ENDIF

	END = SUBINDEX(PARAM(1:PLEN),COL+1,'+') - 1

	IF (END.GE.0) PLUS = END + 1

	IF (END.GT.0) END = STR_LEN(PARAM(1:END))

	IF (END.LT.0) END = PLEN

	CALL LJUST(PARAM(COL+1:END),END)

	IF (COL.EQ.END) THEN
	    COL = COL - 1
	    PARAM(END:END) = ' '
	ENDIF

	IF (PARAM(COL+1:END).EQ.'*') PARAM(COL+1:END) = ' '

	STATUS = SD_(PARAM(COL+1:END))

	IF (.NOT.STATUS) THEN

	    IF (STATUS.EQ.'184CC'X) CALL ERROR(3)	! Bad directory name
	    IF (STATUS.EQ.'1C04A'X) CALL ERROR(4)	! No such directory
	    IF (STATUS.EQ.'00024'X) CALL ERROR(5)	! No privilege
	    IF (STATUS.EQ.'00908'X) CALL ERROR(6)	! No such device
	    IF (STATUS.EQ.'00930'X) CALL ERROR(9)	! No more files

	ENDIF

	IF (PLUS.GT.0) THEN

	    CALL GET_FILE(NAME(1:NLEN),PARAM(PLUS:PLEN))

	ELSE

	    STATUS = LIB$SET_LOGICAL(NAME(1:NLEN),
	1			  DEVICE(1:DEVLEN)//DIRECTORY(1:DIRLEN))

	    IF (.NOT.STATUS) CALL ERROR(2)

	ENDIF

	STATUS = LIB$SET_SYMBOL('NAME',NAME(1:NLEN))

	IF (.NOT.STATUS) CALL ERROR(8,STATUS)

	CALL EXIT(EXITCODE)

	END
	SUBROUTINE CHECK_LOGICAL(SOURCE,DEST,LENGTH)

*	Moves logical name string from SOURCE to DEST, then checks its
*	syntax (since LIB$SET_LOGICAL will accept just about anything
*	without aborting).  The name must begin with a letter and con-
*	tain only letters, numbers, dollar signs, or underscores.  The
*	letters are converted to uppercase.

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) SOURCE,DEST

	CHARACTER*1 TEST

	LENGTH = STR_LEN(SOURCE)

	IF (LENGTH.EQ.0) CALL ERROR(1)

	CALL STR$UPCASE(DEST(1:LENGTH),SOURCE(1:LENGTH))

	DO I=1,LENGTH

	    TEST = DEST(I:I)

	    IF (TEST.LT.'A'.OR.TEST.GT.'Z') THEN

		IF (I.EQ.1) CALL ERROR(1)

		IF (TEST.LT.'0'.AND.TEST.NE.'$') CALL ERROR(1)

		IF (TEST.GT.'9'.AND.TEST.NE.'_') CALL ERROR(1)

	    ENDIF

	ENDDO

	END
	SUBROUTINE LJUST(STRING,ILEN)

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) STRING

	L = LEN(STRING)

	DO WHILE (STRING(1:1).EQ.' '.AND.L.GT.0)

	    STRING = STRING(2:)

	    L = L - 1
	    ILEN = ILEN - 1

	ENDDO

	END
	SUBROUTINE GET_FILE(NAME,STRING)

	IMPLICIT INTEGER (A-Z)

	CHARACTER*(*) NAME,STRING

	CHARACTER*128 DEVICE,DIRECTORY

	COMMON /SD_LOC/ DEVLEN,DIRLEN,DEVICE,DIRECTORY

	CHARACTER*256 FILENAME

	EQUIVALENCE (FILENAME,DEVICE)

	CONTEXT = 0

	SLEN = LEN(STRING)

	STRING(1:1) = ' '

	CALL LJUST(STRING,SLEN)

	STATUS = LIB$FIND_FILE(DEVICE(1:DEVLEN)//
	1		   DIRECTORY(1:DIRLEN)//STRING(1:SLEN),
	2					FILENAME,CONTEXT,'*.*',)

	IF (.NOT.STATUS) CALL ERROR(7)

	FLEN = INDEX(FILENAME,';') - 1

	IF (INDEX(STRING(2:SLEN),'.').EQ.0) THEN	! File name had no type

	    COL = INDEX(FILENAME(1:FLEN),']') + 1

	    FLEN = SUBINDEX(FILENAME(1:FLEN),COL,'.') - 1

	ENDIF

	STATUS = LIB$SET_LOGICAL(NAME,FILENAME(1:FLEN))

	IF (.NOT.STATUS) CALL ERROR(2)

	END
	SUBROUTINE ERROR(CODE,STATUS)

	IMPLICIT INTEGER (A-Z)

	CHARACTER*2 B

	PARAMETER ( B = CHAR(7) // CHAR(7) )

	CALL LIB$PUT_LINE(' ')

	GO TO (1,2,3,4,5,6,7,8,9),CODE

1	CALL LIB$PUT_LINE('  Syntax Error  '//B,2,3)
	GO TO 100

2	CALL LIB$PUT_LINE('  Error defining logical name  '//B,2,3)
	GO TO 100

3	CALL LIB$PUT_LINE('  Invalid Directory Name  '//B,2,3)
	GO TO 100

4	CALL LIB$PUT_LINE('  No Such Directory  '//B,2,3)
	GO TO 100

5	CALL LIB$PUT_LINE('  No Privilege For This Directory  '//B,2,3)
	GO TO 100

6	CALL LIB$PUT_LINE('  No Such Device  '//B,2,3)
	GO TO 100

7	CALL LIB$PUT_LINE('  No Such File  '//B,2,3)
	GO TO 100

8	CALL LIB$PUT_LINE('  Error Setting Symbol  '//B,2,3)
	CALL LIB$STOP(%VAL(STATUS))

9	CALL LIB$PUT_LINE('  End of traversal reached  '//B,2,3)

100	CALL EXIT('10000004'X)		! Abort, without a message

	END
