!<BLF/WIDTH:79>
MODULE SD (MAIN = GO,
		IDENT = '01'
		) =
BEGIN
%(Program to set default directories and disk specs.
Neal Lippman)%
!
!REVISIONS:
!
! [NL001]: 5/4/80 -- ADD SD $ FEATURE (UNDOCUMENTED NICETY)
!

LIBRARY 'SYS$LIBRARY:STARLET.L32';

REQUIRE 'SYS$LIBRARY:CLIMAC.REQ';

FORWARD ROUTINE
    GO;

EXTERNAL ROUTINE
    LIB$PUT_OUTPUT : ADDRESSING_MODE (GENERAL),
    DCL$$_CRELOG,
    SYS$CLI : ADDRESSING_MODE (ABSOLUTE),
    SYS$SETDDIR : ADDRESSING_MODE (ABSOLUTE);

FIELD
    MAKELINE_FIELDS =
	SET
	LEN = [0, 0, 16, 0],
	POINTER = [4, 0, 32, 0],
	MAXLEN = [8, 0, 16, 0],
	STRING = [10, 0, 0, 0],
	DESC = [0, 0, 0, 0]
	TES;

MACRO
    MAKELINE (NAME, L) =
 
		NAME : BLOCK[L+10,BYTE] FIELD(MAKELINE_FIELDS)
			INITIAL(WORD(L,0),LONG(NAME+10),WORD(L),
			BYTE(REP L OF (%C' ') )) %;

OWN
    CLIBLOCK : $CLIREQDESC (RQTYPE = GETCMD),
    DISKCHANGE : INITIAL (0),
    DIR : INITIAL (0),
    CHAN,
    MAKELINE (CLISTRING, 256),
    MAKELINE (OLDDIR, 63),
    MAKELINE (OLDDISK, 63),
    MAKELINE (NEWDIR, 63),
    MAKELINE (NEWDISK, 63);

MACRO
    DESCRIPTOR [] =
		UPLIT LONG(%CHARCOUNT(%STRING(%REMAINING)),
				UPLIT BYTE(%STRING(%REMAINING)))%;

BIND
    CRPUT = UPLIT BYTE(%CHAR (13)),
    DISK = DESCRIPTOR (SYS$DISK);

LITERAL
    TRUE = 1,
    FALSE = 0;

MACRO
    CR =
 %CHAR(13)%,
    LF =
%CHAR(10)%,
    CRLF =
 %CHAR(13,10)%;

FORWARD ROUTINE
    FIX_NUM,
    GET_LAST : NOVALUE,
    SET_LAST : NOVALUE,
    CHECKDIR : NOVALUE,
    SHO_DEF : NOVALUE,
    SET_DEF : NOVALUE;


ROUTINE GO =
    BEGIN
    %(This routine handles everything from getting info from cli to
parsing command line to setting dir and directory.
)%

    LOCAL
	STAT,
	ISTAT,
	TEMP;

    OWN
	MAKELINE (TEMPDISK, 63);

    IF (STAT = $ASSIGN (DEVNAM = DESCRIPTOR (TT), CHAN = CHAN)) NEQ
	SS$_NORMAL
    THEN
	RETURN .STAT;

    IF (STAT = SYS$SETDDIR (0, NEWDIR [LEN], NEWDIR [DESC]))
						!Get current directory
	NEQ %X'10001'
    THEN
	RETURN .STAT;

    IF (ISTAT = $TRNLOG (LOGNAM = DISK, RSLLEN = NEWDISK [LEN],
	    RSLBUF = NEWDISK [DESC])) NEQ SS$_NORMAL
    THEN
	RETURN .ISTAT;				!Exit if can't get disk spec.

    SYS$CLI (CLIBLOCK);
    CH$MOVE (.(CLIBLOCK [CLI$Q_RQDESC])<0, 16>, 	!Move command line
	.(CLIBLOCK [CLI$Q_RQDESC] + 4), CLISTRING [STRING]);
    CLISTRING [LEN] = .(CLIBLOCK [CLI$Q_RQDESC])<0, 16>;
						!Get length clistring

    IF NOT .CLISTRING [LEN] EQL 0
    THEN
					!If not true, just show current
	BEGIN					!default.

	MACRO
	    CHAR (N) =
 (N+10),0,8,0%;

	!First deal with a disk spec found and pull it off from clistring
	!by setting flag.

	LOCAL
	    IDESC : VECTOR [2, LONG],
	    ISTAT;

	DIR = TRUE;				!Want dir reset.
	GET_LAST ();
	SET_LAST ();

	IF NOT CH$FAIL (ISTAT = CH$FIND_CH (.CLISTRING [LEN],
						!Check for disk
		    CLISTRING [STRING], %C':'))
	THEN
	    BEGIN

	    LOCAL
		TEMPSTRING : VECTOR [256, BYTE],
		TMP;

	    DISKCHANGE = TRUE;			!Want device reset
	    TMP = CH$DIFF (.ISTAT, CLISTRING [STRING]) + 1;
						!This is len of disk string
	    CLISTRING [LEN] = .CLISTRING [LEN] - .TMP;	!New len of clistring
	    CH$MOVE (.CLISTRING [LEN], CLISTRING [CHAR (.TMP)],
		TEMPSTRING [0]);
	    NEWDISK [LEN] = .TMP;
	    CH$MOVE (.TMP, CLISTRING [STRING], NEWDISK [STRING]);
	    CH$MOVE (.CLISTRING [LEN], TEMPSTRING [0], CLISTRING [STRING]);
	    END;

!Now deal with lognam translation on the disk.

	WHILE 1 DO
	    BEGIN
	    (IDESC [0])<0, 16> = .NEWDISK [LEN] - 1;
	    IDESC [1] = .NEWDISK [POINTER];
	    TEMPDISK [LEN] = 63;

	    IF (ISTAT = $TRNLOG (LOGNAM = IDESC, RSLLEN = TEMPDISK [LEN],
		    RSLBUF = TEMPDISK [DESC])) NEQ SS$_NORMAL
	    THEN

		IF .ISTAT NEQ SS$_NOTRAN THEN $EXIT (CODE = .ISTAT);

	    IF .ISTAT NEQ SS$_NOTRAN
	    THEN
	    !Deal with setup of new disk and dir stuff.
		BEGIN

		IF NOT CH$FAIL (ISTAT = CH$FIND_CH (.TEMPDISK [LEN],
			    TEMPDISK [STRING], %C':'))
		THEN
		    BEGIN

		    LOCAL
			TMP,
			TEMPSTRING : VECTOR [256, BYTE];

		    TMP = CH$DIFF (.ISTAT, TEMPDISK [STRING]) + 1;
						!Len of disk spec
		    TEMPDISK [LEN] = .TEMPDISK [LEN] - .TMP;
		    CH$MOVE (.TEMPDISK [LEN], TEMPDISK [CHAR (.TMP)],
			TEMPSTRING [0]);
		    NEWDISK [LEN] = .TMP;
		    CH$MOVE (.TMP, TEMPDISK [STRING], NEWDISK [STRING]);

		    IF .TEMPDISK [LEN] NEQ 0
		    THEN
			BEGIN
			CH$MOVE (.TEMPDISK [LEN], TEMPSTRING [0],
			    NEWDIR [STRING]);
			NEWDIR [LEN] = .TEMPDISK [LEN]
			END;

		    END
		ELSE
		    BEGIN
		    NEWDISK [LEN] = 0;
		    DISKCHANGE = FALSE;
		    NEWDIR [LEN] = .TEMPDISK [LEN];
		    CH$MOVE (.NEWDIR [LEN], TEMPDISK [STRING],
			NEWDIR [STRING]);
		    EXITLOOP
		    END;

		END
	    ELSE
		EXITLOOP;

	    END;

	IF .CLISTRING [CHAR (0)] EQL %C'['
	THEN
	    					!Strip off brackets.
	    BEGIN

	    LOCAL
		TEMPSTRING : VECTOR [256, BYTE];

	    CH$MOVE (.CLISTRING [LEN] - 1, CLISTRING [CHAR (1)],
		TEMPSTRING [0]);
	    CLISTRING [LEN] = .CLISTRING [LEN] - 1;
	    CH$MOVE (.CLISTRING [LEN], TEMPSTRING [0], CLISTRING [STRING])
	    END;

	IF .CLISTRING [CHAR (.CLISTRING [LEN] - 1)] EQL %C']'
	THEN
	    CLISTRING [LEN] = .CLISTRING [LEN] - 1;

	WHILE .CLISTRING [CHAR (0)] EQL %C'-' DO
	    BEGIN				!Handle - commands

	    LOCAL
		TEMPSTRING : VECTOR [256, BYTE];

	    LOCAL
		J;

	    DECR I FROM .NEWDIR [LEN] - 1 TO 0 DO
		BEGIN				!Scan for a move-up
		J = .I;

		IF NOT CH$FAIL (CH$FIND_CH (1, NEWDIR [CHAR (.I)], %C'.'))
		THEN
		    EXITLOOP;			!Found a period

		IF .I EQL 0
		THEN
		    BEGIN

		    IF (.CLISTRING [LEN] EQL 1) OR (.CLISTRING [CHAR (1)] EQL
			%C'-')
		    THEN
			BEGIN
			LIB$PUT_OUTPUT (DESCRIPTOR (%CHAR (13),
				'too far up', %CHAR (10)));
			SET_DEF ();
			SHO_DEF ();
			RETURN 1
			END;

		    CLISTRING [LEN] = .CLISTRING [LEN] - 1;

		    IF NOT (((.CLISTRING [CHAR (1)] GEQ %C'A') AND (.CLISTRING
			[CHAR (1)] LEQ %C'Z')) OR ((.CLISTRING [CHAR (1)] GEQ
			%C'0') AND (.CLISTRING [CHAR (1)] LEQ %C'9')))
		    THEN
			BEGIN
			NEWDIR [CHAR (.NEWDIR [LEN] - 1)] = %C'.';
			NEWDIR [LEN] = .NEWDIR [LEN] + 1;
			CH$MOVE (.CLISTRING [LEN] - 1, CLISTRING [CHAR (2)],
			    NEWDIR [CHAR (.NEWDIR [LEN])]);
			NEWDIR [LEN] = .NEWDIR [LEN] + .CLISTRING [LEN];
			NEWDIR [CHAR (.NEWDIR [LEN])] = %C']';
			NEWDIR [LEN] = .NEWDIR [LEN] + 1;
			END
		    ELSE
			BEGIN
			CH$MOVE (.CLISTRING [LEN], CLISTRING [CHAR (1)],
			    NEWDIR [CHAR (1)]);
			NEWDIR [CHAR (0)] = %C'[';
			NEWDIR [LEN] = .CLISTRING [LEN] + 1;
			NEWDIR [CHAR (.NEWDIR [LEN])] = %C']';
			NEWDIR [LEN] = .NEWDIR [LEN] + 1;
			END;

		    SET_DEF ();
		    SHO_DEF ();
		    RETURN 1
		    END;

		END;

	    NEWDIR [CHAR (.J)] = %C']';
	    !Add ] for compatibility w/other parts
	    NEWDIR [LEN] = .J + 1;
	    CLISTRING [LEN] = .CLISTRING [LEN] - 1;	!Decr len

	    IF .CLISTRING [LEN] EQL 0
	    THEN
						!Just minus signs here
		BEGIN
		SET_DEF ();
		SHO_DEF ();
		RETURN 1
		END;

	    CH$MOVE (.CLISTRING [LEN], CLISTRING [CHAR (1)], TEMPSTRING);
	    CH$MOVE (.CLISTRING [LEN], TEMPSTRING, CLISTRING [STRING]);
	    END;

	SELECTONE .CLISTRING [CHAR (0)] OF
	    SET

	    [%C'?'] :
		BEGIN				!Help!!!!!
		LIB$PUT_OUTPUT (DESCRIPTOR (CRLF, ' SD -- Help File ', CRLF,
			CRLF, ' Command                 Function', crlf,
			crlf,
			' SD .                    Set to login default',
			crlf, ' SD dir                  Set to "dir"', crlf,

			' SD .dir                 Set to "dir" subdir of current dir'
		    , crlf,

			' SD >dir                 Set to "dir" on current level'
		    , crlf,

			' SD <                    Set to last dir set to by SD'
		    , crlf, ' SD ^                    Move up one level',
			crlf,

			' SD ^^                   Move to top level of current tree'
		    , crlf,

			' SD $                    Set to translation of SD$LOGIN'
		    , crlf, crlf,

			' minus signs cause SD to go up one level per minus sign'
		    , crlf, crlf,

			' Note that all device names are subject to logical name translation.'
		    , crlf));
		$EXIT (CODE = SS$_NORMAL);
		END;

	    [%C'.'] : 				!Set to a subdir
		BEGIN

		IF .CLISTRING [LEN] EQL 1
		THEN
		    				!Unless setting to login
						!default.
		    BEGIN

		    LOCAL
			TMP;

		    CLISTRING [LEN] = 256;

		    IF NOT (TMP = $TRNLOG (LOGNAM = DESCRIPTOR ('SYS$LOGIN'),
			    RSLLEN = CLISTRING [LEN],
			    RSLBUF = CLISTRING [DESC])) EQL SS$_NORMAL
		    THEN
			RETURN .TMP;

		    TMP = CH$FIND_CH (.CLISTRING [LEN], CLISTRING [STRING],
			%C':');			!Find colon.
		    TMP = CH$DIFF (.TMP, CLISTRING [STRING]) + 1;
		    NEWDISK [LEN] = .TMP;
		    CH$MOVE (.NEWDISK [LEN], CLISTRING [STRING],
			NEWDISK [STRING]);
		    NEWDIR [LEN] = .CLISTRING [LEN] - .TMP;
		    CH$MOVE (.NEWDIR [LEN], CLISTRING [CHAR (.TMP)],
			NEWDIR [STRING]);
		    DISKCHANGE = TRUE;
		    SET_DEF ();
		    SHO_DEF ();
		    RETURN 1
		    END;

		NEWDIR [LEN] = .NEWDIR [LEN] - 1;	!Get rid of final ']'
		CH$MOVE (.CLISTRING [LEN], 	!Move subdirectory spec on
		    CLISTRING [CHAR (0)], NEWDIR [CHAR (.NEWDIR [LEN])]);
		NEWDIR [LEN] = .NEWDIR [LEN] + .CLISTRING [LEN];
		NEWDIR [CHAR (.NEWDIR [LEN])] = %C']';	!bracket
		NEWDIR [LEN] = .NEWDIR [LEN] + 1;
		END;
! [NL001]: 5/2/80 -- SD $ FEATURE

	    [%C'$'] :
		BEGIN

		LOCAL
		    TMP;

		CLISTRING [LEN] = 256;

		IF NOT (TMP = $TRNLOG (LOGNAM = DESCRIPTOR ('SD$LOGIN'),
			RSLLEN = CLISTRING [LEN], RSLBUF = CLISTRING [DESC]))
		    EQL SS$_NORMAL
		THEN
		    BEGIN
		    CLISTRING [LEN] = 256;

		    IF NOT (TMP = $TRNLOG (LOGNAM = DESCRIPTOR ('SYS$LOGIN'),
			    RSLLEN = CLISTRING [LEN],
			    RSLBUF = CLISTRING [DESC])) EQL SS$_NORMAL
		    THEN
			RETURN .TMP

		    END;

		TMP = CH$FIND_CH (.CLISTRING [LEN], CLISTRING [STRING], %C':')
		;				!Find colon.
		TMP = CH$DIFF (.TMP, CLISTRING [STRING]) + 1;
		NEWDISK [LEN] = .TMP;
		CH$MOVE (.NEWDISK [LEN], CLISTRING [STRING], NEWDISK [STRING])
		;
		NEWDIR [LEN] = .CLISTRING [LEN] - .TMP;
		CH$MOVE (.NEWDIR [LEN], CLISTRING [CHAR (.TMP)],
		    NEWDIR [STRING]);
		DISKCHANGE = TRUE;
		SET_DEF ();
		SHO_DEF ();
		RETURN 1
		END;

	    [%C'<'] : 				!Go to last default
		BEGIN
		NEWDIR [LEN] = .OLDDIR [LEN];
		NEWDISK [LEN] = .OLDDISK [LEN];
		CH$MOVE (.OLDDIR [LEN], OLDDIR [STRING], NEWDIR [STRING]);
		CH$MOVE (.OLDDISK [LEN], OLDDISK [STRING], NEWDISK [STRING]);
		DISKCHANGE = TRUE;
		DIR = TRUE;
		SET_DEF ();
		SHO_DEF ();
		RETURN 1;
		END;

	    [%C'^'] : 				!Move up one level
		BEGIN

		SELECTONE .CLISTRING [CHAR (1)] OF
		    SET

		    [%C'^'] : 		!Wants to go up to top level dir.
			BEGIN

			LOCAL
			    J;

			INCR I FROM 0 TO .NEWDIR [LEN] - 1 BY 1 DO
			    BEGIN
			    J = .I;

			    IF NOT CH$FAIL (CH$FIND_CH (1,
					NEWDIR [CHAR (.I)], %C'.'))
			    THEN
				EXITLOOP;

			    IF .I EQL .NEWDIR [LEN] - 1
			    THEN
						!Go away if couldn't find a
				BEGIN		!period
				LIB$PUT_OUTPUT (DESCRIPTOR (at, %CHAR (32),
					top, %CHAR (32), level, %CHAR (32),
					directory, %CHAR (13), %CHAR (10)));
				SHO_DEF ();
				RETURN 1
				END;

			    END;

			!Now adjust len and put in bracket.
			NEWDIR [LEN] = .J + 1;
			NEWDIR [CHAR (.J)] = %C']';
			END;

		    [OTHERWISE] :
			BEGIN

			LOCAL
			    J;


			!Scan backwards along newdir[string] until find a ., then replace it
			!with a ']' and reset newdir[len]..

			DECR I FROM .NEWDIR [LEN] - 1 TO 0 BY 1 DO
			    BEGIN
			    J = .I;

			    IF NOT CH$FAIL (CH$FIND_CH (1,
					NEWDIR [CHAR (.I)], %C'.'))
			    THEN
				EXITLOOP;

			    !We have found a period, so exit loop to
			    !process it.

			    IF .I EQL 0
			    THEN
				BEGIN
				!if we have finished, go away cause no '.'
				LIB$PUT_OUTPUT (DESCRIPTOR (at, %CHAR (32),
					top, %CHAR (32), level, %CHAR (32),
					directory, %CHAR (%X'2E'), %CHAR (13))
				);
				RETURN 1
				END;

			    END;

			NEWDIR [CHAR (.J)] = %C']';
			NEWDIR [LEN] = .J + 1;
			END;
		    TES;

		END;

	    [%C'>'] : 				!Go across
		BEGIN

		LOCAL
		    J;

		DECR I FROM .NEWDIR [LEN] - 1 TO 0 BY 1 DO
		    BEGIN
		    J = .I;

		    IF NOT CH$FAIL (CH$FIND_CH (1, NEWDIR [CHAR (.I)], %C'.'))

		    THEN
			EXITLOOP;

		    IF .I EQL 0
		    THEN
			BEGIN
			LIB$PUT_OUTPUT (DESCRIPTOR (you, %char (32), are,
				%char (32), at, %char (32), a, %char (32),
				top, %char (32), level, %char (32),
				directory, %CHAR (%X'2E')));
			RETURN 1
			END;

		    END;

		!J is location of first period. start to copy from there.

		IF .CLISTRING [CHAR (1)] NEQ %C'.' THEN J = .J + 1;

		CH$MOVE (.CLISTRING [LEN], 	!Move rest of string in
		    CLISTRING [CHAR (1)], NEWDIR [CHAR (.J)]);
		NEWDIR [LEN] = .J + .CLISTRING [LEN];	!Set new length.
		NEWDIR [CHAR (.NEWDIR [LEN] - 1)] = %C']';
		END;

	    [OTHERWISE] : 			!Just set dir and let's get
		BEGIN

		IF NOT (.CLISTRING [LEN] EQL 0)
		THEN
		    				!In case just setting device
		    BEGIN
		    NEWDIR [CHAR (0)] = %C'[';	!Starting bracket
		    CH$MOVE (.CLISTRING [LEN], 	!Move dir over
			CLISTRING [CHAR (0)], NEWDIR [CHAR (1)]);
		    NEWDIR [LEN] = .CLISTRING [LEN] + 1;
		    NEWDIR [CHAR (.NEWDIR [LEN])] = %C']';
						!Put in right bracket
		    NEWDIR [LEN] = .NEWDIR [LEN] + 1;	!And set final length
		    END;

		END;
	    TES;

	END;

!Whew! Now that we have gone off and created the new dir and new disk specs,
!time to call routines to cause them to happen.
    SET_DEF ();
    SHO_DEF ();
    RETURN 1;
    END;

ROUTINE SET_DEF : NOVALUE =
    BEGIN

    LOCAL
	ISTAT;

    IF .DIR
    THEN
	BEGIN

	IF (ISTAT = SYS$SETDDIR (NEWDIR [DESC], 0, 0)) NEQ %X'10001'
	THEN
	    $EXIT (CODE = .ISTAT)

	END;

    IF .DISKCHANGE
    THEN
	BEGIN
	ISTAT = DCL$$_CRELOG (DISK, NEWDISK [DESC]);

	IF (.ISTAT NEQ SS$_SUPERSEDE) AND (.ISTAT NEQ SS$_NORMAL)
	THEN
	    $EXIT (CODE = .ISTAT);

	END;

    IF .DISKCHANGE OR .DIR THEN CHECKDIR (NEWDIR [DESC]);

    RETURN;
    END;

ROUTINE SHO_DEF : NOVALUE =
    BEGIN
    %( routine to show user his default
)%

    $QIOW (CHAN = .CHAN, FUNC = IO$_WRITEVBLK, P1 = .NEWDISK [POINTER],
	P2 = .NEWDISK [LEN]);
    $QIOW (CHAN = .CHAN, FUNC = IO$_WRITEVBLK, P1 = .NEWDIR [POINTER],
	P2 = .NEWDIR [LEN]);
    $QIOW (CHAN = .CHAN, FUNC = IO$_WRITEVBLK, P1 = CRPUT, P2 = 1);
    RETURN;
    END;

ROUTINE CHECKDIR (DIRDESC) : NOVALUE =
    BEGIN
    %(Get dir set to from set_dir; munge it and output appropriate value to
term.)%

    LOCAL
	LEN,
	STRING : BLOCK [256, BYTE];

    LOCAL
	STATUS,
	J;

    MACRO
	CHAR (N) =
 N,0,8,0%;

    BIND
	NODIR = UPLIT BYTE(%CHAR (13), 'This directory does not exist.', %CHAR
	    (10), %CHAR (13));

    OWN
	RESNAME : VECTOR [NAM$C_MAXRSS, BYTE],
	EXPNAME : VECTOR [NAM$C_MAXRSS, BYTE],
	NAMBLOCK : $NAM (RSA = RESNAME, RSS = NAM$C_MAXRSS, ESA = EXPNAME,
		ESS = NAM$C_MAXRSS),
	FAB : $FAB (NAM = NAMBLOCK);

!Munge directory desc stuff:
    LEN = ..DIRDESC<0, 16>;
    CH$MOVE (.LEN, .(.DIRDESC + 4), STRING);

    DECR I FROM .LEN - 1 TO 0 DO
	BEGIN

	IF .STRING [CHAR (.I)] EQL %C'.'
	THEN
	    BEGIN			!Make look like a file spec...
	    STRING [CHAR (.I)] = %C']';
	    STRING [CHAR (.LEN - 1)] = %C'.';
	    CH$MOVE (3, UPLIT BYTE('DIR'), STRING [CHAR (.LEN)]);
	    LEN = .LEN + 3;
	    EXITLOOP
	    END;

	IF .I EQL 0
	THEN
	    BEGIN			!Set for top level and check for it

	    LOCAL
		TEMPSTRING : VECTOR [256, BYTE];

	    IF FIX_NUM (.DIRDESC) NEQ 0
	    THEN
						!Fix deal with numeric dir
		BEGIN
		LEN = ..DIRDESC<0, 16>;
		CH$MOVE (.LEN, .(.DIRDESC + 4), STRING)
		END;				!and  re-move stuff

	    CH$MOVE (.LEN - 1, STRING [CHAR (1)], TEMPSTRING);
	    CH$MOVE (7, UPLIT BYTE('000000]'), STRING [CHAR (1)]);
	    CH$MOVE (.LEN - 1, TEMPSTRING, STRING [CHAR (8)]);
	    LEN = .LEN + 7;
	    STRING [CHAR (.LEN - 1)] = %C'.';
	    LEN = .LEN + 1;
	    CH$MOVE (3, UPLIT BYTE('DIR'), STRING [CHAR (.LEN)]);
	    LEN = .LEN + 3;
	    EXITLOOP
	    END;

	END;

!Now check for existance of dir
    FAB [FAB$L_FNA] = STRING;
    FAB [FAB$B_FNS] = .LEN;
    J = $RMS_PARSE (FAB = FAB);

    IF NOT .J
    THEN
	BEGIN
	$QIO (CHAN = .CHAN, FUNC = IO$_WRITEVBLK, P1 = NODIR, P2 = 33);
	RETURN
	END;

    J = $RMS_SEARCH (FAB = FAB);

    IF (.J EQL RMS$_NMF) OR (.J EQL RMS$_FNF)
    THEN
	BEGIN
	$QIO (CHAN = .CHAN, FUNC = IO$_WRITEVBLK, P2 = 33, P1 = NODIR);
	RETURN;
	END
    ELSE

	IF (.J EQL RMS$_NORMAL) THEN RETURN;

    $EXIT (CODE = .J);
    END;

ROUTINE SET_LAST : NOVALUE =
    BEGIN
    %(Set last default directory)%

    LOCAL
	ISTAT;

    BIND
	OLDDISK = DESCRIPTOR ('SD$OLDDISK'),
	OLDDIR = DESCRIPTOR ('SD$OLDDIR');

    ISTAT = DCL$$_CRELOG (OLDDIR, NEWDIR [DESC]);

    IF (.ISTAT NEQ SS$_SUPERSEDE) AND (.ISTAT NEQ SS$_NORMAL)
    THEN
	BEGIN
	$EXIT (CODE = .ISTAT)
	END;

    ISTAT = DCL$$_CRELOG (OLDDISK, NEWDISK [DESC]);

    IF (.ISTAT NEQ SS$_SUPERSEDE) AND (.ISTAT NEQ SS$_NORMAL)
    THEN
	BEGIN
	$EXIT (CODE = .ISTAT)
	END;

    RETURN;
    END;

ROUTINE GET_LAST : NOVALUE =
    BEGIN
    %(Tranlate logical names to get last default)%

    LOCAL
	ISTAT;

    BIND
	DOLDDIR = DESCRIPTOR ('SD$OLDDIR'),
	DOLDDISK = DESCRIPTOR ('SD$OLDDISK');

    OLDDIR [LEN] = 63;
    OLDDISK [LEN] = 63;
    ISTAT = $TRNLOG (LOGNAM = DOLDDIR, RSLLEN = OLDDIR [LEN],
	RSLBUF = OLDDIR [DESC]);

    IF .ISTAT NEQ SS$_NORMAL
    THEN

	IF .ISTAT NEQ SS$_NOTRAN THEN $EXIT (CODE = .ISTAT);

    ISTAT = $TRNLOG (LOGNAM = DOLDDISK, RSLLEN = OLDDISK [LEN],
	RSLBUF = OLDDISK [DESC]);

    IF .ISTAT NEQ SS$_NORMAL
    THEN

	IF .ISTAT NEQ SS$_NOTRAN THEN $EXIT (CODE = .ISTAT);

    RETURN;
    END;

ROUTINE FIX_NUM (DIRDESC) =
    BEGIN
    %( This routine takes in a dir spec in the form [num,num] and returns
it in the form [numnum], with leading zeros added as necessary)%

    LOCAL
	ISTAT,
	I1,
	I2,
	I3,					!General purpose variables
	NLEN,
	NEWLINE : BLOCK [256, BYTE] FIELD (MAKELINE_FIELDS);

    MACRO
	CHAR (N) =
 (N+10),0,8,0%;

    BIND
	ZEROSTRING = UPLIT BYTE( REP 3 OF (%C'0'));

    BIND
	DESC = .DIRDESC;			!Address descriptor

    MAP
	DESC : VECTOR [2, LONG];		!As two longwords

    BIND
	LEN = DESC;

    MAP
	LEN : VECTOR [2, WORD];			!And get length

    IF CH$FAIL (ISTAT = CH$FIND_CH (.LEN, .DESC [1], %C',')) THEN RETURN 0;

					!If no comma then spec already okay,
    						!so exit
!Okay, now deal with constructing a new dir string --
    NEWLINE [CHAR (0)] = %C'[';
    NLEN = 1;
    ISTAT = CH$DIFF (.ISTAT, .DESC [1]) - 1;	!Len of first number...
    CH$MOVE (3 - .ISTAT, ZEROSTRING, NEWLINE [CHAR (1)]);
						!Put on nec zeros
    NLEN = .NLEN + 3 - .ISTAT;
    CH$MOVE (.ISTAT, (.DESC [1] + 1), NEWLINE [CHAR (.NLEN)]);
						!Move on the rest of the num
    NLEN = .NLEN + .ISTAT;			!And up the len again
    I1 = .LEN - (.ISTAT + 2);
    I2 = .DESC [1] + .ISTAT + 2;
    ISTAT = CH$FIND_CH (.I1, .I2, %C']');
    ISTAT = CH$DIFF (.ISTAT, .I2);		!Get new len of stuff
    CH$MOVE (3 - .ISTAT, ZEROSTRING, NEWLINE [CHAR (.NLEN)]);
    NLEN = .NLEN + 3 - .ISTAT;
    CH$MOVE (.ISTAT, .I2, NEWLINE [CHAR (.NLEN)]);
    NLEN = .NLEN + .ISTAT;
    NEWLINE [CHAR (.NLEN)] = %C']';
    NLEN = .NLEN + 1;
    CH$MOVE (.NLEN, NEWLINE [STRING], .DESC [1]);
    LEN = .NLEN;
    RETURN 1;
    END;
END

ELUDOM