HOWE%ORN.MFENET@NMFECC.ARPA (09/28/87)
The attached VMS_SHAR file contains a Fortran subroutine which updates
the SD stack list. SD is a program to set the default directory and it
has appeared regularly on the DECUS tapes. If the directory is set outside
of SD (with SWING, for example), the SD stack of previous directories may
be updated by calling this subroutine (in SWING, the subroutine exit_swing
should call update_stack).
The routine is set up to update the SD stack in the format used by Dale
Coy's version of SD. Obvious modifications can be made if Alan Zirkle's
original format for the SD stack is to be updated.
Herb Howe
Oak Ridge National Laboratory
Oak Ridge, TN 37830
(615)574-1353
....................... Cut between dotted lines and save ......................
$!..............................................................................
$! VAX/VMS archive file created by VMS_SHAR V-4.03 05-Aug-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by HOWE
$! on Monday 28-SEP-1987 10:02:12.72
$!
$! It contains the following 1 file:
$! UPDATE_STACK.FOR
$!==============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set (Output_File,b,o);
Position (Beginning_of(b));Loop x:=Erase_Character(1); Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;Move_Horizontal
(-Current_Offset);EndLoop;Move_Vertical(1);ExitIf Mark(None)=End_of(b)
EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="UPDATE_STACK.FOR"
$ Check_Sum_is=1800356684
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X
Xc Update SD stack (for Dale Coy version of SD)
X
X Subroutine Update_Stack
X
X Integer*2 CDevLen, CDirLen, EnvLen
X Integer*2 SdirLen, SD_SP_Number, Stack_Depth
X Character SD_Stack_Pointer*2, SD_Dir*256, SD_Slotnn*9
X Character*256 Current_Directory, Environment, Current_Device
X Include '($LIBCLIDEF)'
X Data Stack_Depth /20/ ! How many SD_Slots
X
X Istat = Lib$Get_Symbol ('SD_Stack_Pointer', SD_Stack_Pointer)
X
X If (Istat .NE. 1) Return ! SD is not initialized
X
X SD_Slotnn = 'SD_SLOT' // SD_Stack_Pointer
X
X Istat = Lib$Get_Symbol ( SD_Slotnn, SD_Dir, SdirLen)
X
X Call Lib$Sys_TrnLog('SYS$DISK',%Ref(CDevLen),
X 1 %Descr(Current_Device))
X
X Call Sys$SetdDir( %Val(0), %Ref(CDirLen),
X 1 %Descr(Current_Directory))
X
X Environment = Current_Device(:CDevLen)
X Environment(CDevLen+1:) = Current_Directory
X EnvLen = CDevLen + CDirLen
X
X If (Environment(:EnvLen) .NE. SD_Dir(:SdirLen)) Then
X
X Read (SD_Stack_Pointer,910) SD_SP_Number
X910 Format(i2)
X
X SD_SP_Number = MOD( SD_SP_Number + 1, Stack_Depth )
X
X Write (SD_Stack_Pointer,108) SD_SP_Number
X108 Format (I2.2)
X
X Call Lib$Set_Symbol (%Descr('SD_Stack_Pointer'),
X 1 %Descr(SD_Stack_Pointer) ,LIB$K_CLI_GLOBAL_SYM)
X
X Write (SD_Slotnn(8:9),108) SD_SP_Number
X
X Call Lib$Set_Symbol (%Descr(SD_Slotnn),
X 1 %Descr(Environment(:EnvLen)) ,LIB$K_CLI_GLOBAL_SYM)
X
X End If
X
X Return
X End
$ GoSub Convert_File
$ Exit