C-----------------------------------------------------------------------
C	SD MAIN (Preliminary Version 4.0)  October 1986
C
C	FORTRAN Driver for SD
C
C		Dale E. Coy
C		Los Alamos National Laboratory
C
C-----------------------------------------------------------------------

	PROGRAM  SDMAIN

	Implicit Integer*4 (A-Z)
	Character*4 P1
                  
	Include 'SD_Common.Dat'
	Include '($LIBCLIDEF)'  
	Include '($LIBDEF)'
	Include '($SSDEF)'


C NOTE: Lines beginning C$$ and C$! are from the original SD.COM 
C-----------------------------------------------------------------------
C$!
C$!  Alan L. Zirkle      Naval Surface Weapons Center
C$!			Code K53
C$!  22 October 1984	Dahlgren, Virginia  22448
C$!
C-----------------------------------------------------------------------
C  Modified Sept/Oct 1986, Dale E. Coy, Los Alamos National Laboratory.
C-----------------------------------------------------------------------
         
	Status = Lib$Get_Symbol (%Descr('SD_Stack_Pointer'),
	1		%Descr(SD_Stack_Pointer),
	2		,%Ref(Table))
                  

      	Call Sys$SetdDir( %Val(0), %Ref(CDirLen), 
	1	%Descr(Current_Directory)) 
 
	Call Lib$Sys_TrnLog('SYS$DISK',%Ref(CDevLen),
	1	%Descr(Current_Device))

  
	Environment = Current_Device(:CDevLen)
	Environment(CDevLen+1:) = Current_Directory
	EnvLen = CDevLen + CDirLen
  

C		Now do something based on whether SD_Stack_Pointer existed

12	If (Status .EQ. LIB$_NOSUCHSYM) then


C$$   sd_sp == 0
		Call Lib$Set_Symbol (%Descr('SD_Stack_Pointer'),
	1		%Descr('00'),LIB$K_CLI_GLOBAL_SYM)

		SD_Stack_Pointer = '00'

C			And set the SD_SLOTs
		Do I = 1, Stack_Depth

			SD_SP_Number = I - 1


C$$   sd_slotN == F$ENVIRONMENT("DEFAULT")

			Write (SD_Slotn(8:9),108) SD_SP_Number
108				Format (I2.2)
C			SD_Slotn(1:7) = 'SD_SLOT'
	
			Call Lib$Set_Symbol (%Descr(SD_Slotn),
	1			%Descr(Environment(:EnvLen)),
	2			LIB$K_CLI_GLOBAL_SYM)
		End Do

		SD_SP_Number = 0

	Else
C			Get Stack Entry and Compare with Environment.
C			We do this because some other process may have
C			changed our directory.
  		Read (SD_Stack_Pointer,102, Err=30) SD_SP_Number
102			Format(I2)
		GoTo 40
C			If there is an error reading:
30		Status = LIB$_NOSUCHSYM
		GoTo 12  ! Reset Stack

40		Write (SD_Slotn(8:9),108) SD_SP_Number
	
		Status = Lib$Get_Symbol (%Descr(SD_Slotn),
	1		%Descr(String),%Ref(SLen))

		If (Status .EQ. LIB$_NOSUCHSYM) GoTo 12
  
		If (String(:Slen) .NE. Environment(:EnvLen)) then
			Print *,'  Unexpected SD Stack Environment'

			SD_SP_Number = MOD(SD_SP_Number+1, Stack_Depth)
			Write (SD_Stack_Pointer,108) SD_SP_Number 

			Call Lib$Set_Symbol (%Descr('SD_Stack_Pointer'),
	1      			%Descr(SD_Stack_Pointer),
	2			LIB$K_CLI_GLOBAL_SYM)       

			Write (SD_Slotn(8:9),108) SD_SP_Number

			Call Lib$Set_Symbol (%Descr(SD_Slotn),
	1			%Descr(Environment(:EnvLen)),
	2			LIB$K_CLI_GLOBAL_SYM)
		End If

	END IF                 


C-----------  IMPLEMENTATION DEFERRED ----------------------------------
C$!
C$$   IF F$TYPE(sd__0) .EQS. "" THEN sd__0 == "SYS$SYSDEVICE:"	! LOCAL1 ******
C$$   IF F$TYPE(sd__1) .EQS. "" THEN sd__1 == "DISK$COY:"		! LOCAL *******
C$!                                                                        
C-------------------------------------------------------------------------


C To get passed parameters:

50	PLen = 0
	Param = ' '

	Call Lib$Get_Foreign (%Descr(Param),,%Ref(PLen))

	If (PLen .LE. 0) then
		Print *,'  ',Environment(:EnvLen)
		GoTo 9999
	Else
		K = Lib$MatchC (' ',Param(:Plen))
		If (K .LE. 0) then
			P1 = Param(:PLen)
		Else
			P1 = Param(:K-1)
   		End If
	End If

	If ((P1 .EQ. '?') .OR. (P1 .EQ. 'HELP')) then

C--------------  HELP? ------------------------------------
C$$ HELP:

		If ((K .LE. 0) .OR. (K+1 .GT. PLen)) then
			String = 'HELP/NOLIBLIST/NOUSERLIBRARY/'//
 	1		 'LIBRARY='//Help_Library_Name//' SD'
		Else                                               
			String = 'HELP/NOLIBLIST/NOUSERLIBRARY/'//
 	1		 'LIBRARY='//Help_Library_Name//
	2		 ' SD '//Param(K+1:PLen)
		End If

		Call Lib$Do_Command (String)

		GoTo 9999    ! Note: This will never be executed.

C---------------- Display Versions? -----------------------------
	Else If (P1 .EQ. '$') then

C$$ VERSION:
		Print *,'        '//ReVideo//' SDMAIN Version 4.0A '//Dull
        	Do_ID = .TRUE.
		Call SD
		Call SDTree
		Do_ID = .FALSE.
		GoTo 9999
	End If

C---------------------------------------------------------------------

	Call SD

C---------------------------------------------------------------------

C		SD Sets Change if we are to change directories.

	If (ChgLen .LE. 0) then
		GoTo 400
	Else If (CHANGE(:ChgLen) .EQ. ' ') then
		GoTo 400
	End If

C---------------- IMPLEMENTATION DEFERRED ------------------------
C$$   IF F$PARSE("SDEXIT.COM") .EQS. "" THEN  GOTO SETIT
C$$   IF F$SEARCH("SDEXIT.COM") .NES. "" THEN  @SDEXIT
C$!---------------------------------------------------------------

C$$ SETIT:
C$$   SET DEFAULT 'change'
C$!

200	Continue

	K = Lib$MatchC (':',Change(:ChgLen))

	If (K .GT. 0) then
		Current_Device = Change(:K)
		CDevLen = K
		Call Lib$Set_Logical ('SYS$DISK',Current_Device(:K))
		J = K+1
	Else
		CDevLen = 0
		J = 1
	End If

	If (J .LE. ChgLen) then
		Current_Directory = Change(J:ChgLen)
		CDirLen = ChgLen - J + 1
	      	Call Sys$SetdDir( %Descr(Current_Directory(:CDirLen)), 
	1		%Val(0), %Val(0)) 
                                                           
	End If

C$! Display the new default and update SD's history stack.
C$!
	Environment = Current_Device(:CDevLen)
	Environment(CDevLen+1:) = Current_Directory
	EnvLen = CDevLen + CDirLen

	Print *,'  ',Environment(:EnvLen)
	Print *

C$$   sd_sp == (1 + sd_sp) .AND. 7
C$$   sd_slot'sd_sp' == change
C$!

	SD_SP_Number = MOD(SD_SP_Number+1, Stack_Depth)
	Write (SD_Stack_Pointer,108) SD_SP_Number 
		Call Lib$Set_Symbol (%Descr('SD_Stack_Pointer'),
	1      		%Descr(SD_Stack_Pointer),LIB$K_CLI_GLOBAL_SYM)       

C$$   sd_slotN == F$ENVIRONMENT("DEFAULT")

	Write (SD_Slotn(8:9),108) SD_SP_Number
C	SD_Slotn(1:7) = 'SD_SLOT'
	
		Call Lib$Set_Symbol (%Descr(SD_Slotn),
	1		%Descr(Environment(:EnvLen)),
	2		LIB$K_CLI_GLOBAL_SYM)


C----------------------- IMPLEMENTATION DEFERRED ------------------------
C$$   IF F$SEARCH("SDENTRY.COM") .NES. "" THEN  @SDENTRY
C$!----------------------------------------------------------------------

C		SD Also sets the logicals Do_Tree, Do_Dir, and Do_Stack

400	Continue
C$$ NOCHANGE:
C$$ TREE:

	If (Do_Tree) then

		ChgLen = 0
		Change = ' '
		Call SDTREE
		Do_Tree = .FALSE.
		If (ChgLen .GT. 0) GoTo 200         ! Change again

	End If

C$! Display the contents of SD's history stack.
C$$ STACK:

	If (Do_Stack) then

		ChgLen = 0
		Change = ' '
		Call SD_Display_Stack
		Do_Stack = .FALSE.
		If (ChgLen .GT. 0) GoTo 200         ! Change again

	End If

C$$ DIR:
C$$   DIRECTORY 'rest'		! The SD program set DCL symbol 'rest'

	If (Do_Dir) then
		If (RLen .LE. 0) then
			String = 'DIRECTORY'
			RLen = 9
		Else
			String = 'DIRECTORY '//Rest(:RLen)
			RLen = RLen + 10
		End If

		Call Lib$Do_Command (String(:RLen))

C			Note that the following will NOT be executed.
		
		Do_Dir = .FALSE.

	End If

C		Exit to DM Program
	If (Do_DM) then

		Call Lib$Do_Command (%Descr('DM'))

C			Note that the following will NOT be executed.
		
		Do_DM = .FALSE.

	End If

9999	Continue

	End
