Trailing-Edge
-
PDP-10 Archives
-
integ_tools_tops20_v7_30-apr-86_dumper
-
tools/comten1/path.com
There are 5 other files named path.com in the archive. Click here to see a list.
$ verify = F$VERIFY("NO")
$!
$! PATH.COM
$! Stolen: 7-Jul-82 QCJ
$! Modification: 16-Nov-82 SLP (verification)
$! Modification: 6-Jul-83 MEH (check existence of directories when
$! using "."'s and "-"'s in path_spec)
$! Modification: 1-Mar-84 JLD (major cosmetic changes and upgrade to
$! recognize network nodes for DECNET)
$! Modification: 16-May-84 JLD (correct error message on protected
$! subdirectories to not read nonexistent)
$!
$ original = F$LOGICAL("SYS$DISK") + F$DIRECTORY()
$ switch = "N"
$ node = "N"
$ len = F$LENGTH(P1)
$ switch_loc = F$LOCATE("/",P1)
$ IF switch_loc .NE. len THEN switch = "Y"
$ IF .NOT. switch THEN GOTO start
$ switch_val = F$EXTRACT(switch_loc + 1,len - switch_loc - 1,p1)
$ P1 = F$EXTRACT(0,switch_loc,P1)
$ start:
$ ON WARNING THEN GOTO error
$ len = F$LENGTH(P1)
$ IF len .EQ. 0 THEN GOTO out
$ no_switches:
$ IF F$LOCATE("<",P1) .NE. len THEN GOTO pathout
$ IF F$LOCATE(">",P1) .NE. len THEN GOTO pathin
$ IF F$LOCATE("::",P1) .NE. len THEN GOTO network
$ IF F$LOCATE(":",P1) .NE. len THEN GOTO device
$ IF F$LOCATE("[",P1) .NE. len THEN GOTO pmain
$ IF F$LOCATE(".",P1) .NE. len THEN GOTO pmain
$ IF F$LOGICAL(P1) .NES. "" THEN GOTO logical
$!
$! Assume this is a main directory and path to it (or create it!!).
$!
$ len = len + 2
$ P1 = "[''P1']"
$ GOTO pmain
$!
$! Comes here if a /switch was included.
$!
$ switches:
$ switch = "N"
$ IF F$LOCATE(switch_val,"MAKE") .EQ. 0 THEN GOTO switch_make
$ IF F$LOCATE(switch_val,"CREATE") .EQ. 0 THEN GOTO switch_make
$ WRITE SYS$OUTPUT "?Invalid switch ''switch_val'"
$ GOTO end
$!
$! The /MAKE or /CREATE switch.
$!
$ switch_make:
$ directory = F$DIRECTORY()
$ WRITE SYS$OUTPUT "$ CREATE/DIRECTORY ''directory'"
$ CREATE/DIRECTORY/NOLOG []
$ GOTO out
$!
$! Comes here to >>>>.
$!
$ pathin:
$ len = len - 1
$ P1 = F$EXTRACT(1,len,P1)
$ IF F$LOCATE("::",P1) .NE. len THEN GOTO network
$ IF F$LOCATE(":",P1) .NE. len THEN GOTO device
$ pathinagain:
$ nextup = F$LOCATE(">",P1)
$ fullen = F$LENGTH(P1)
$ IF nextup .EQ. fullen THEN GOTO pathinok
$ part = F$EXTRACT(0,nextup,P1)
$ tp1 = "[.''part']"
$ nextup = nextup + 1
$ P1 = F$EXTRACT(nextup,fullen,P1)
$ GOTO setpathin
$ pathinok:
$ tp1 = "[.''P1']"
$ IF .NOT. switch THEN GOTO pathinoknotswitch
$ switchloc = F$LOCATE("/",P1)
$ part = F$EXTRACT(0,switchloc,P1)
$ tp1 = "[.''part']"
$ P1 = F$EXTRACT(switchloc,len,P1)
$ SET DEFAULT 'tp1'
$ GOTO switches
$ pathinoknotswitch:
$ OPEN/READ/ERROR=checkexistence dirtest 'P1'.DIR
$ CLOSE dirtest
$ P1 = ""
$ setpathin:
$ SET DEFAULT 'tp1'
$ IF P1 .NES. "" THEN GOTO pathinagain
$ GOTO out
$ checkexistence:
$ check = F$SEARCH("''P1'.DIR")
$ IF check .EQS. "" THEN GOTO nonexistent
$ WRITE SYS$OUTPUT "?Subdirectory protected"
$ SET DEFAULT 'original'
$ GOTO end
$ nonexistent:
$ WRITE SYS$OUTPUT "?Nonexistent subdirectory"
$ SET DEFAULT 'original'
$ GOTO end
$!
$! Comes here to "PATH network::".
$!
$ network:
$ node = "Y"
$ colons = F$LOCATE("::",P1)
$ network = F$EXTRACT(0,colons + 2,P1)
$ P1 = F$EXTRACT(colons + 2,len - colons,p1)
$ disk = F$LOGICAL("SYS$DISK")
$ colons = F$LOCATE("::",disk)
$ disklen = F$LENGTH(disk)
$ IF colons .NE. disklen THEN -
disk = F$EXTRACT(colons + 2,disklen - colons - 2, disk)
$ network_device = network + disk
$ SET DEFAULT 'network_device'
$ GOTO start
$!
$! Comes here to "PATH device:".
$!
$ device:
$ colon = F$LOCATE(":",P1)
$ device = F$EXTRACT(0,colon + 1,P1)
$ P1 = F$EXTRACT(colon + 1,len - colon,p1)
$ len = F$LENGTH(P1)
$ IF node THEN device = network + device
$ SET DEFAULT 'device'
$ IF len .LE. 0 THEN GOTO out
$!
$! Comes here to "PATH [".
$!
$ pmain:
$!
$ IF len .EQ. 1 THEN SET DEFAULT 'F$LOGICAL("SYS$LOGIN")'
$ IF len .EQ. 1 THEN GOTO out
$!
$ IF F$LOCATE("[",P1) .NE. len THEN GOTO left_bracket
$ P1 = "[" + P1
$ len = len + 1
$ left_bracket:
$ IF F$LOCATE("]",P1) .NE. len THEN GOTO right_bracket
$ P1 = P1 + "]"
$ len = len + 1
$ right_bracket:
$!
$ rghtbrck = F$LOCATE("[",p1)
$ IF F$EXTRACT(rghtbrck + 1,1,P1) .EQS. "." THEN GOTO not_a_top_directory
$ first_dot = F$LOCATE(".",P1)
$ top_directory = F$EXTRACT(rghtbrck+1,first_dot - 1,P1)
$ top_len = F$LENGTH(top_directory)
$ IF F$LOCATE("[",top_directory) .NE. top_len THEN GOTO left_brack
$ top_directory = "[''top_directory'"
$ top_len = top_len + 1
$!
$ left_brack:
$ IF F$LOCATE("]",top_directory) .NE. top_len THEN GOTO right_brack
$ top_directory = top_directory + "]"
$ right_brack:
$ SET DEFAULT 'top_directory'
$ P1 = "[" + F$EXTRACT(first_dot,len - first_dot,P1)
$ len = F$LENGTH(P1)
$ not_a_top_directory:
$!
$ no_of_dashes = 0
$ other_dashes = 0
$ dash = F$LOCATE("-",P1)
$ IF dash .EQ. len THEN GOTO check_periods
$ tmp_dash = dash
$!
$ find_more_dashes:
$ no_of_dashes = no_of_dashes + 1
$ tmp_string = F$EXTRACT(tmp_dash + 1,len - tmp_dash - 1,P1)
$ other_dashes = F$LOCATE("-",tmp_string) + tmp_dash + 1
$ IF other_dashes .EQ. len THEN GOTO no_more_dashes
$ tmp_dash = other_dashes
$ GOTO find_more_dashes
$!
$ no_more_dashes:
$ P1 = F$EXTRACT(tmp_dash + 1,len - tmp_dash - 1,P1)
$ len = F$LENGTH(p1)
$!
$ move_up_a_level:
$ IF no_of_dashes .LE. 0 THEN GOTO check_periods
$ no_of_dashes = no_of_dashes - 1
$ SET DEFAULT [-]
$ GOTO move_up_a_level
$!
$ check_periods:
$ IF (len .EQ. 1) .AND. (P1 .EQS. "]") THEN GOTO out
$ no_of_periods = 0
$ other_periods = 0
$ period = F$LOCATE(".",P1)
$ IF period .EQ. len THEN GOTO no_period
$ tmp_period = period
$!
$ find_more_periods:
$ no_of_periods = no_of_periods + 1
$ tmp_string = F$EXTRACT(tmp_period + 1,len - tmp_period - 1,P1)
$ other_periods = F$LOCATE(".",tmp_string) + tmp_period + 1
$ IF other_periods .EQ. len THEN GOTO no_more_periods
$ dir_no_'no_of_periods' = F$EXTRACT(tmp_period + 1,other_periods - tmp_period - 1,P1)
$ tmp_period = other_periods
$ GOTO find_more_periods
$!
$ no_more_periods:
$ dir_no_'no_of_periods' = F$EXTRACT(tmp_period + 1,other_periods - tmp_period - 2,P1)
$ total_dirs = no_of_periods
$!
$ test_existence:
$ IF no_of_periods .LE. 0 THEN GOTO out
$ number = total_dirs - no_of_periods + 1
$ test_dir = dir_no_'number'
$ no_of_periods = no_of_periods - 1
$ IF switch THEN GOTO creating_directory
$ OPEN/READ/ERROR=check_existence dirtest 'test_dir'.DIR
$ CLOSE dirtest
$!
$ creating_directory:
$ SET DEFAULT [.'test_dir']
$ GOTO test_existence
$!
$ check_existence:
$ check = F$SEARCH("''test_dir'.DIR")
$ IF check .EQS. "" THEN GOTO nonexistent
$ WRITE SYS$OUTPUT "?Subdirectory protected"
$ SET DEFAULT 'original'
$ GOTO end
$!
$ no_period:
$ IF F$LOCATE("[",P1) .NE. len THEN GOTO nexta
$ P1 = "[" + P1
$ len = len + 1
$ nexta:
$ IF F$LOCATE("]",P1) .NE. len THEN GOTO next
$ P1 = P1 + "]"
$ len = len + 1
$ next:
$ SET DEFAULT 'P1'
$ GOTO out
$!
$! Comes here to "PATH <<<".
$!
$ pathout:
$ k = F$DIRECTORY()
$ IF F$LOCATE(".",k) .EQ. F$LENGTH(k) THEN GOTO inroot
$ SET DEFAULT [-]
$ inroot:
$ P1 = F$EXTRACT(1,len,P1)
$ tp1 = F$EXTRACT(0,1,P1)
$ IF tp1 .EQS. "<" THEN GOTO pathout
$ IF P1 .NES. "" THEN GOTO start
$ GOTO out
$!
$! Comes here to "PATH logical".
$!
$ logical:
$ SET DEFAULT 'p1'
$ GOTO out
$!
$! End on errors.
$!
$ error:
$ WRITE SYS$OUTPUT "?Invalid path command"
$ SET DEFAULT 'original'
$ GOTO end
$!
$! General end.
$!
$ out:
$ IF switch THEN GOTO switches
$ IF F$LENGTH(P2) .EQ. 0 THEN GOTO end
$ PATH 'P2' 'P3' 'P4' 'P5' 'P6'
$ EXIT
$ end:
$ SHOW DEFAULT
$ IF verify THEN SET VERIFY