! Explanation at end of file
$	MKD__QUIET = %x10000000				! Inhibit display (bit 28)
$	MKD__SUCCESS = MKD__QUIET + %x0001		! Severity 1 (success)
$	on warning   then exit MKD__QUIET .or. $STATUS
$	on control_y then exit MKD__QUIET + %x0004	! Severity 4 (fatal error)
$	if f$type(MKD__QUIET) .eqs. "" then exit %x10000000
!
$	display_comma = "@$COM:LIBTOOL DISPLAY_COMMA"
$	display_list = "@$COM:LIBTOOL DISPLAY_LIST"
!
$	if f$trnlnm("$COM") .eqs. ""
$	then
$		$COM = f$environment("PROCEDURE")
$		$COM = f$parse($COM,,,"DEVICE")+f$parse($COM,,,"DIRECTORY")
$		@'$COM'LIBINIT
$	endif
!
!-------
! Set up the search list for source code (stored in logical $MKD)
!
$	if f$trnlnm("$MKD") .eqs. "" then define/nolog $MKD 'f$trnlnm("$LIB")
$	XMKD = ""
$	I = -1
$ NEXT_XMKD:
$	I = I+1
$	if f$trnlnm("$MKD",,I) .nes. ""
$	then
$		XMKD = XMKD+","+f$trnlnm("$MKD",,I)
$		goto NEXT_XMKD
$	endif
$	XMKD = XMKD-","
!
!-------
! Pick up command line arguments
!
$	if f$search("$EXE:LIBARG.EXE") .nes. ""
$	then
$		run $EXE:LIBARG		! Extract switches
$	else
$		gosub OLD_LIBARG	! Use if LIBARG.EXE is missing
$	endif
!
$	SRCDIR = ""
$	OBJDIR = "[-]"
$	EXEDIR = "[-]"
$	CONFIRM_LIB__OLB = 0
$	NOEXECUTABLE = 0
$	GOGO = 0
$	DEBUG = 0
$	SPARSE = 0
$	I = 0
$ NEXT_COLON_ARG:
$	I = I+1
$	ARGI = f$element(I,"/",ARG)
$	if ARGI .nes. "/"
$	then
$		ARGI = "/"+ARGI
$		JPOS = ARGI
$		STRING = f$extract(0,4,ARGI)
$		if	STRING .eqs. "/OBJ" .or. -
			STRING .eqs. "/EXE" .or. -
			STRING .eqs. "/SRC"  then JPOS = STRING
$		@$COM:LIBSUB LOOKUP_KEY LIB__ANS 'JPOS -
		 "/DEBUG,/NOLIB,/NOEXE,/HELP,/?,/CHECK,/FRESH,/GO,/SPARSE,/OBJDIR=,/EXEDIR=,/SRCDIR="
$		if LIB__ANS .eqs. "" then -
			signal 'P1 W INVQUAL "invalid or non-unique qualifier ignored: ''JPOS'"
$		if LIB__ANS .eqs. "/OBJDIR=" .or. -
		   LIB__ANS .eqs. "/EXEDIR=" .or. -
		   LIB__ANS .eqs. "/SRCDIR="
$		then
$			STRING = f$extract(1,6,LIB__ANS)
$			JPOS = f$extract(f$locate("=",ARGI)+1,999,ARGI)
$			@$COM:LIBCD ~STAY 'JPOS
$			'STRING = LIB__ANS
$		endif
$		if LIB__ANS .eqs. "/DEBUG"	then DEBUG = 1
$		if LIB__ANS .eqs. "/NOLIB"	then CONFIRM_LIB__OLB = 1
$		if LIB__ANS .eqs. "/NOEXE"	then NOEXECUTABLE = 1
$		if LIB__ANS .eqs. "/GO"		then GOGO = 1
$		if LIB__ANS .eqs. "/SPARSE"	then SPARSE = 1
$		if LIB__ANS .eqs. "/FRESH"	then P2 = "&"
$		if LIB__ANS .eqs. "/CHECK"	then P2 = "@"+P2
$		if LIB__ANS .eqs. "/HELP" .or. LIB__ANS .eqs. "/?"
$		then
$			call MKDHELP
$			echo LIB__ANS B "  Continue with MKD (YES/NO) ?" NO S
$			if .not. LIB__ANS then signal 'P1 E CANCEL "Canceled by user"
$		endif
$		goto NEXT_COLON_ARG
$	endif
!
$	if P1 .eqs. "MKD"
$	then
$		if f$type(LIB__NUNIT) .nes. "INTEGER"
$		then
$			LIB__NUNIT == 12
			signal 'P1 W NONUNIT "global symbol LIB__NUNIT does not exist" -
				"assumed value is ''LIB__NUNIT'"
$		endif
$		if f$type(LIB__SUBLENGTH) .nes. "INTEGER"
$		then
$			LIB__SUBLENGTH == 27
			signal 'P1 W NOSUBLNG "global symbol LIB__SUBLENGTH does not exist" -
				"assumed value is ''LIB__SUBLENGTH'"
$		endif
$		if f$search("$SAM:MKD.REC") .eqs. ""
$		then
$			signal 'P1 W NOMKDREC "info file $SAM:MKD.REC does not exist" -
				"jump to option MKD & to create new version"
$			P2 = "&"
$		endif
$		SUBL  = LIB__SUBLENGTH
$		NUNIT = LIB__NUNIT	! Room for 12 entries
$		DATL  = 23
$		UNIT  = SUBL+DATL+1
$		if f$extract(0,1,P2) .eqs. "&" then goto MKDCHANGE
$	endif
!
!-------	List of acceptable languages. Compile commands for each language
!		Define LNK$LIBRARY logical for use with C
!
$	LANGS	= "FOR,C,PAS,MAR,CLD"
$!	STRING	= "fortran/float=ieee_float/extended/check=all,'+ -
!		  "cc/float=ieee_float/ieee_mode=denorm,pascal,macro,set command"
$	STRING	= "fortran/extended/check=all,cc,pascal,macro,set command"
$	I = -1
$ NEXTLANGDEF:
$	I = I+1
$	LANG = f$element(I,",",LANGS)
$	if LANG .nes. ","
$	then
$		if f$type('LANG) .eqs. "STRING"
$		then
$			'LANG = f$edit('LANG,"UPCASE")
$			signal 'P1 I 'LANG'DEF "compiling as ''&LANG'"
$		else
$			'LANG = f$element(I,",",STRING)
$		endif
$		goto NEXTLANGDEF
$	endif
$	if f$type(link) .eqs. "STRING"
$	then
$		link = f$edit(link,"UPCASE")
$		signal 'P1 I LINKDEF "linking as ''link'"
$	else
$		link	= "link"
$	endif
!
$	define/job/nolog	LNK$LIBRARY	SYS$LIBRARY:VAXCRTL
!
!-------	 Ask for name of main program to be compiled and linked
!
$	if P2 .eqs. ""
$	then
$		if f$type(LIB__MAIN) .eqs. "STRING" then P2 = LIB__MAIN
$		if P2 .eqs. "" then P2 = "^Z"
$		if P2 .eqs. "^Z" .or. .not. GOGO
$		then
$			echo LIB__ANS S "  Main program (^Z=STOP) ?" 'P2 U,C,Z
$			if LIB__ANS .eqs. "^Z" then signal 'P1 E CANCEL "request canceled by user"
$			P2 = LIB__ANS
$		endif
$	endif
!
$	if f$extract(0,1,P2) .eqs. "@" then goto MKDCHECK
!
!-------	If a file name extension is specified (.FOR,.C,.PAS,.MAR,.CLD), 
!		the corresponding language is assumed.
!
$	LANGT = LANGS
$	LANG = f$parse(P2,,,"TYPE")-"."
$	if f$locate(","+LANG+",",","+LANGS+",") .ne. f$length(LANGS)+2 then LANGT = LANG
!
!-------	Find the main program source file
! P2DIR is the directory specified for the source file. If absent, P2DIR
!	reduces to the working directory. If P2DIR is not the working directory
!	only P2DIR is searched for main program source code
! SRCDIR is the source directory from a previous compilation
!
$	DEFAULT = f$environment("default")
$	if SRCDIR .nes. ""
$	then
$		P2DIR	= SRCDIR
$	else
$		SRCDIR	= f$trnlnm("$TMP")
$		if SRCDIR .eqs. "" then SRCDIR = f$trnlnm("$FOR")
$		P2DIR	= f$parse(P2,,,"NODE")+f$parse(P2,,,"DEVICE")+f$parse(P2,,,"DIRECTORY")
$	endif
$	P2	= f$parse(P2,,,"NAME")		! Extract file name
$	STRING	= P2DIR		! First try to find source file in P2DIR
$	I = -1
$ NEXTLANG:
$	I = I+1
$	LANG = f$element(I,",",LANGT)
!
$	if LANG .nes. ","
$	then
$		if f$search(STRING+P2+"."+LANG) .eqs. "" then goto NEXTLANG
$		compile = 'LANG
$		say "  ''LANG' source code found in ",STRING ! Source file found
$		goto MAINFOUND
$	endif
!
$	if	P2DIR  .nes. DEFAULT then -
		signal 'P1 E NOFILE "No ''LANGT' source found in ''P2DIR'"
$	if	SRCDIR .eqs. DEFAULT .or. -
		SRCDIR .eqs. STRING then -
		signal 'P1 E NOFILE "No ''LANGT' source found in ''SRCDIR'"
$	signal 'P1 W NOFILE "No ''LANGT' source found in ''DEFAULT'"
!
$	STRING = SRCDIR		! Now try to find source file in SRCDIR
$	I = -1
$	goto NEXTLANG
!
$ MAINFOUND:
$	SRCDIR = STRING		! Source file found in SRCDIR
$	if .not. NOEXECUTABLE then define/nolog $TMP 'SRCDIR
$!	if SRCDIR .nes. DEFAULT
$	if f$locate("[-",OBJDIR) .ne. f$length(OBJDIR) .or.	-
	   (.not. NOEXECUTABLE .and. f$locate("[-",EXEDIR) .ne. f$length(EXEDIR))
$	then
$		set default 'SRCDIR
$		cd
$	endif				! Store name of working dir in $TMP
!
$	STRING = OBJDIR
$	if OBJDIR .eqs. "[-]"
$	then
$		@$COM:LIBCD ~STAY 'OBJDIR
$		STRING = LIB__ANS
$	endif
$	if f$locate("[000000]",STRING) .nes. f$length(STRING) then -
		signal 'P1 E INVDIR "destination of object files assigned to ''STRING'" -
			"object files should not be stored in the root directory" -
			"either set the destination using the /objdir qualifier" -
			"or move all source code from the main directory to a subdirectory"
!
$	if NOEXECUTABLE
$	then
$		EXEDIR = OBJDIR
$	else
$		STRING = EXEDIR
$		if EXEDIR .eqs. "[-]"
$		then
$			@$COM:LIBCD ~STAY 'EXEDIR
$			STRING = LIB__ANS
$		endif
$		if f$locate("[000000]",STRING) .nes. f$length(STRING) then -
			signal 'P1 E INVDIR "destination of executable files assigned to ''STRING'" -
			"executable files should not be stored in the root directory" -
			"either set the destination using the /exedir qualifier" -
			"or move all source code from the main directory to a subdirectory"
$	endif
!
! The following is a kludge to be able to deal with old HELIOS main programs
! that need to be compiled with the /noalign qualifier (only needed on the
! Alpha machine).
!
$	call MKD$FOREXTRA "''P2'" COMPILE
$	compile = compile+LIB__ANS
$	call MKD$FOREXTRA "''P2'" LINK
$	link    = link   +LIB__ANS
!
$	goto 'P1'$MK
!
$ MK$MK:
$	P2SRC = SRCDIR+P2+"."+LANG
$	P2OBJ = "SYS$SCRATCH:"+P2+".OBJ"
$	P2EXE = EXEDIR+P2+".EXE"
$	LIB__MAIN == P2
$	if f$environment("DEPTH") .eq. 1 then @$COM:LIBSUB KEY_CHANGE_EDT 'P2SRC
$	on warning then goto MK$MK_ERROR
$	on control_y then goto MK$MK_ERROR
$	compile/object='P2OBJ 'P2SRC
$	if NOEXECUTABLE
$	then
$		set noon
$		delete 'P2OBJ';*
$		set on
$	else
$		call MKD$SET_OLB
$		link/executable='P2EXE 'P2OBJ 'LIB__ANS
$		set noon
$		@$COM:LIBCOM VPUR 'P2EXE
$		delete 'P2OBJ';*
$		set on
$		set default 'EXEDIR
$		cd
$	endif
$	exit MKD__SUCCESS
$ MK$MK_ERROR:
$	STATUS = $STATUS
$	set noon
$	delete 'P2OBJ';*
$	set on
$	exit MKD__QUIET .or. STATUS
!
$ MKD$MK:
$	on warning   then goto MKD_OOPS
$	on control_y then goto MKD_OOPS		! Change error handler
$	if .not. NOEXECUTABLE then LIB__MAIN == P2
$	SOURCE = SRCDIR+P2+"."+LANG		! Main program source file
$!
$! Decide whether FORTRAN debugger is to be invoked or not
$!
$	if (DEBUG .and. LANG .nes. "MAR" .and. LANG .nes. "CLD")
$	then					! FORTRAN debugger included
$		DINQ = "Y"			! Store debugger info
$		signal 'P1 I DEBUG "Debug qualifier will be included in compile and link commands"
$		SWITCH1 = "/nooptimize/debug"	! Compile switch
$		SWITCH2 = "/debug"		! Link switch
$	else					! FORTRAN debugger not included
$		DINQ = "N"
$		SWITCH1 = ""
$		SWITCH2 = ""
$	endif
$!
$! See if information about this program exist on MKD.REC
$!
$	open/read/write/share=write RECFILE $SAM:MKD.REC /error=OPEN_REC
$	goto OPEN_OK
$ OPEN_REC:
$	signal 'P1 E OPEN_ERR "Open error on MKD.REC" '$STATUS
$ OPEN_OK:
$	JPOS = 0
$	ISIN = -1
$	JTEST = 0
$	SKEY[0,SUBL] := "''P2'"
$	RECIN = ""
$	read/lock RECFILE/index=0/key="''SKEY'" RECIN /error=MAIN_INFO
$	ISIN = -1+f$length(RECIN)/UNIT
$ MAIN_INFO:
$	if JTEST .le. ISIN
$	then
$		SIN'JTEST = f$edit(f$extract(JPOS,SUBL,RECIN),"TRIM")
$		JPOS = JPOS+SUBL
$		DATIN'JTEST = f$extract(JPOS,DATL,RECIN)
$		JPOS = JPOS+DATL
$		DEBIN'JTEST = f$extract(JPOS,1,RECIN)
$		JPOS = JPOS+1
$		JTEST = JTEST+1
$		goto MAIN_INFO
$	endif
$	say f$fao( "!/!80*-" )
$	if ISIN .ge. 0
$	then
$		display_list SIN -
			" ... included" -
			"     Previous compilation of main program :"
$	else
$		say "  No default list of modules from a previous compilation available"
$	endif
$	say f$fao( "!80*-" )
$!
$	_CHANGE = 0
$	OBJECT = OBJDIR+P2		! All object files assumed to be in parent dir
$	FLINK = OBJECT			! Put main file name in link string
$!
$! Decide whether main program should be recompiled (if an object file already exists)
$!
$	LIB__ANS == 1			! Suppose object file exists
$	if f$search(OBJECT+".OBJ") .eqs. "" then LIB__ANS == 0 ! Check whether ...
$					! object file exists, if not, compile
$	if LIB__ANS .and. ISIN .ge. 0	! Check: object file exist and info available?
$	then				! Check: revision date consistent with info, if ...
$		if DATIN0 .eqs. f$file_attributes(SOURCE,"RDT")	.and. DEBIN0 .eq. DINQ
$		then			! If revision data and debugger info consistent, then accept object file
$			ISOUT = 0
$			SOUT0 = SIN0
$			DATOUT0 = DATIN0	! Retain revision date
$			DEBOUT0 = DEBIN0	! Retain debugger info
$			say "  Existing object file used for ",f$parse(SOURCE,,,"NAME")
$			goto SELECT_SUB		! Object file is acceptable
$		endif
$		LIB__ANS == 0			! Ignore object file
$	endif
$!
$	if LIB__ANS
$	then				! Object file exists, but cannot decide whether it's OK
$		echo LIB__ANS B "  Recompile (YES/NO) ?" YES
$		if .not. LIB__ANS
$		then
$			ISOUT = 0
$			SOUT0 = P2
$			DATOUT0 = f$file_attributes(SOURCE,"RDT")
$			DEBOUT0 = " "
$			say "  Existing object file used for ",f$parse(SOURCE,,,"NAME")
$			goto SELECT_SUB
$		endif
$	endif
$!
$	say " ... ''compile' ",f$parse(SOURCE,,,"NAME")
$	if f$environment("DEPTH") .eq. 1 then @$COM:LIBSUB KEY_CHANGE_EDT 'SOURCE
$	compile/object='OBJECT''SWITCH1' 'SOURCE	! Compile main program source file
$	_CHANGE = 1
$	ISOUT = 0
$	SOUT0 = P2
$	DATOUT0 = f$file_attributes(SOURCE,"RDT")	! Store revision data of source file
$	DEBOUT0 = DINQ					! Store debugger info
$	@$COM:LIBCOM VPUR 'OBJECT'.OBJ			! Purge old object files
$!
$! Enter subroutines to be include in the final linking
$!
$ SELECT_SUB:
$	JDEF = 1
$	on warning then goto STORE_REC
$	on control_y then goto STORE_REC
$	REPEAT = -1
$	ADD = -1
$	SELECT = ""
$	DEFAULT = ""
$!
$! Decide what the default subroutine choice is going to be
$!
$ NEXT_SUB:
$	if ISOUT .eq. NUNIT-1
$	then
$		say "  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
$		say "  !!!!!
$		say "  !!!!!  MKD can only remember a maximum of ",NUNIT," modules."
$		say "  !!!!!  You are about to exceed the maximum. MKD will not
$		say "  !!!!!  remember anything entered past this point.
$		say "  !!!!!  (you solve the problem by creating an object library)
$		say "  !!!!!
$		say "  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
$	endif
$	if SELECT .eqs. DEFAULT
$	then
$ SEARCH:
$		DEFAULT = "%"
$		if JDEF .le. ISIN
$		then
$			DEFAULT = SIN'JDEF
$			JTEST = 0
$ TEST_DEF:
$			JTEST = JTEST+1 
$			if JTEST .le. ISOUT
$			then
$				if DEFAULT .eqs. SOUT'JTEST
$				then
$					JDEF = JDEF+1
$					goto SEARCH
$				endif
$				goto TEST_DEF
$			endif
$		endif
$	endif
$!
$	SELECT = DEFAULT
$	if ADD .eq. 1 .and. DEFAULT .eqs. "%" then REPEAT = 0
$						! If adding, switch off repeat mode
$!						! .. when entire input list has been processed
$	if REPEAT .eq. 1 then goto REPEAT_IS_ON
$!
$	if REPEAT .eq. -1
$	then
$		if .not. GOGO
$		then
$			say f$fao( "!/!80*-" )
$			say "  Indicate object libraries by adding the qualifier /LIB to the library name"
$			say "  Indicate linker option files by adding the qualifier /OPT to the file name"
$			say "       %    link all specified modules"
$			say "       -    exclude the default module"
$			say "       +    prompt for more modules after compiling the default list"
$			say "       #    compile and link the default list"
$			say f$fao( "!80*-" )
$		endif
$		REPEAT = 0
$	endif
$!
$	STRING = "  Subroutine/library (% link,- kill,+ add,# all) ?"
$	if DEFAULT .eqs. "%" then STRING = "  Subroutine/library (% link) ?"
$	if GOGO
$	then
$		LIB__ANS == "#"
$	else
$		echo LIB__ANS S "''STRING'" 'DEFAULT U,C	! Prompt for subr/library
$	endif
$	if DEFAULT .eqs. "%"
$	then
$		if LIB__ANS .eqs. "-" then LIB__ANS == DEFAULT
$		if LIB__ANS .eqs. "+" then LIB__ANS == DEFAULT
$		if LIB__ANS .eqs. "#" then LIB__ANS == DEFAULT
$	endif
$	SELECT = LIB__ANS
$!
$	if SELECT .eqs. "-"			! SIN entry killed
$	then
$		if f$locate("/LIB",SIN'JDEF') .eq. f$length(SIN'JDEF')
$		then				! Entry is not a library
$			TEMP = OBJDIR+SIN'JDEF'+".OBJ;*"
$			if f$search(TEMP) .nes. ""
$			then
$				say "  Deleting object files ",TEMP
$				delete/nolog 'TEMP'
$			endif
$		endif				! Delete associated object files
$		SIN'JDEF' = ""			! Kill SIN string
$		SELECT = DEFAULT		! Needed to change next default
$		JDEF = JDEF+1			! Next SIN entry
$		_CHANGE = 1			! Make sure to LINK
$		goto NEXT_SUB
$	endif
$	if SELECT .eqs. "+"			! Process all remaining entries
$	then					! .. then stop at subr/lib prompt
$		ADD = 1
$		SELECT = "#"			! Needed to switch on repeat mode
$	endif
$	if SELECT .eqs. "#"			! Switch on repeat mode
$	then
$		REPEAT = 1			! Repeat is on
$		SELECT = DEFAULT		! Accept default
$	endif
$!
$ REPEAT_IS_ON:
$	if SELECT .eqs. "%" then goto LINK	! No more subroutines: start linking
$!
$	OBJLIB = ""
$	OBJEXT = ".OBJ"
$	if f$locate("/LIB",SELECT) .ne. f$length(SELECT)
$	then					! Check for object library
$		OBJLIB = "/LIB"
$		OBJEXT = ".OLB"
$		I = f$locate("/I",SELECT)	! Should handle "/include"
$		if I .ne. f$length(SELECT)
$		then
$			DUM = f$extract(I+1,999,SELECT)
$			I = f$locate("/",DUM)
$			DUM = "/"+f$extract(0,I,DUM)
$			SELECT = SELECT-DUM
$			I = f$locate("=",DUM)
$			DUM = "/INC"+f$extract(I,999,DUM)
$			SELECT = SELECT+DUM
$			OBJLIB = OBJLIB+DUM
$		endif
$	endif
$	if f$locate("/OPT",SELECT) .ne. f$length(SELECT)
$	then					! Check for linker option file
$		OBJLIB = "/OPT"
$		OBJEXT = ".OPT"
$	endif
!
$	LANGT = LANGS
$	LANG = f$parse(SELECT,,,"TYPE")-"."
$	if f$locate(","+LANG+",",","+LANGS+",") .ne. f$length(LANGS)+2 then LANGT = LANG
$!
$! Set up the entry as it is going to be added to the SOUT list (and ultimately
$! is written to RECFILE)
$!
$	SELECT = f$parse(SELECT-OBJLIB,,,"NAME")+OBJLIB	! Remove file extension
$	if f$length(SELECT) .gt. SUBL then signal 'P1 E ARGTOOLNG -
		"Argument must be less/equal ''SUBL' characters"
$	if SELECT .eqs. DEFAULT then JDEF = JDEF+1
$!
$	JTEST = -1
$ CHECK_SOUT:
$	JTEST = JTEST+1
$	if JTEST .le. ISOUT
$	then				! Check for duplicate entries
$		if SELECT .eqs. SOUT'JTEST
$		then
$			say "  !!!! Duplicate entry ignored, ",SELECT
$			goto NEXT_SUB
$		endif
$		goto CHECK_SOUT
$	endif
$!
$	JTEST = 0
$ CHECK_SIN:
$	JTEST = JTEST+1
$	if JTEST .le. ISIN
$	then				! Check whether info available
$		if SELECT .nes. SIN'JTEST then goto CHECK_SIN
$	endif
$!
$	OBJECT = OBJDIR+SELECT
$!
$ TRY_$MKD:
$	LIB__ANS == 1			! Suppose object file exists. Then check.
$	STRING = OBJECT-OBJLIB+OBJEXT
$	if f$search(STRING) .eqs. ""	! Check
$	then
$		if OBJLIB .nes. "" .and. -	! For libs check $MKD next
			f$extract(0,f$length("$MKD:"),OBJECT) .nes. "$MKD:"
$		then
$			OBJECT = "$MKD:"+(OBJECT-OBJDIR)
$			goto TRY_$MKD
$		endif
$		LIB__ANS == 0
$	endif				! LIB__ANS == 0 : object (lib) not found
$!
$!
$!------	First deal with user object libraries (OBJLIB = "/LIB")
$!  - Stop if object library does not exist (LIB__ANS==0)
$!  - If info is available (JTEST .le. ISIN) then test the revision date of the
$!    library. If a change is detected, set _CHANGE=1 (force compilation)
$!  - If no info available (JTEST .gt. ISIN), set _CHANGE=1 (force compilation)
$!  - Set up ouput info and add library to link string
$!
$	if OBJLIB .nes. ""
$	then
$		if OBJLIB .eqs. "/LIB" then CTYP = "object library"
$		if OBJLIB .eqs. "/OPT" then CTYP = "linker option file"
$		if .not. LIB__ANS
$		then
$			STRING = OBJECT-"$MKD:"-OBJLIB+OBJEXT
$			signal 'P1 E NOOBJLIB -
				"''CTYP' ''STRING' not found" -
				"put ''CTYP' in ''OBJDIR' or ''XMKD'"
$		endif
$		if JTEST .le. ISIN
$		then
$			if DATIN'JTEST .nes. f$file_attributes(OBJECT-OBJLIB+OBJEXT,"RDT") then _CHANGE = 1
$		else
$			_CHANGE = 1
$		endif
$		ISOUT = ISOUT+1			! Accept object library
$		SOUT'ISOUT = SELECT
$		DATOUT'ISOUT = f$file_attributes(OBJECT-OBJLIB+OBJEXT,"RDT")
$		DEBOUT'ISOUT = " "
$		FLINK = FLINK + "," + OBJECT ! Add library to link string
$		say "  User ''CTYP' ''OBJECT'''OBJINC"
$		goto NEXT_SUB
$	endif
$!
$!
$!-------	Now deal with regular functions/subroutine source code
$!  - Check whether the source code exists. Check for .FOR,.C,.PAS,.MAR and .CLD
$!    files. SOURCE is set to the full file name (or "" if no source found).
$!
$	SOURCE = ""
$	I = -1
$ NEXTLANG_SUB:
$	I = I+1
$	LANG = f$element(I,",",LANGT)
$	if LANG .nes. ","
$	then
$		STRING = SELECT+"."+LANG	! Subroutine source file
$		SOURCE = f$search(SRCDIR+STRING)! Try SRCDIR
$		if SOURCE .eqs. ""
$		then				! Try $MKD
$			SOURCE = f$search("$MKD:"+STRING)
$			if SOURCE .eqs. "" then goto NEXTLANG_SUB
$		endif
$		compile = 'LANG			! Language identified
$	else
$		signal 'P1 W NOSRC "Source file for ''SELECT' not found" -
			"Source file must be located in ''SRCDIR'" -
			"Only ''LANGS' files can be processed"
$!
$!------	If no source code present (SOURCE="")
$!  - If no source code, and no object file is available, then exit
$!  - If object file is available, but no source code, then accept object file
$!
$		if .not. LIB__ANS
$		then			! If no object file present, exit
$			signal 'P1 W NOOBJ "Object file ''SELECT'''OBJEXT' not found"
$			say f$fao("     |!65*-|")
$			say f$fao("     |   Object file must be located in !30AS |",OBJDIR)
$			say f$fao("     |   Put source file in !30AS             |",SRCDIR)
$			say f$fao("     |   or put object file in !30AS          |",OBJDIR)
$			say f$fao("     |   !14AS!48* |!/     |!65*-|","Then try again")
$			signal 'P1 E NOOBJ
$		endif
$		ISOUT = ISOUT+1		! Source file doesn't exist: accept object file for want of better
$		SOUT'ISOUT = SELECT
$		DATOUT'ISOUT = " "
$		DEBOUT'ISOUT = " "
$		FLINK = FLINK+","+OBJECT	! Add subroutine to link string
$		signal 'P1 I OBJFND "Existing object file ''SELECT'''OBJEXT' used" -
				    "To override object file put source in ''SRCDIR'"
$		goto NEXT_SUB
$	endif
$!
$!------	If source code present (SOURCE .nes. "")
$!  - If object file present (LIB__ANS==0) and info available (JTEST .le. ISIN)
$!    then accept the object file only if revision date and debugger info are
$!    are consistent.
$!
$	if LIB__ANS .and. JTEST .le. ISIN	! Check: object file exist and info available?
$	then				! Check: revision date consistent with info
$		LIB__ANS == DATIN'JTEST .eqs. f$file_attributes(SOURCE,"RDT")
$		if LIB__ANS .and. DEBIN'JTEST .eq. DINQ
$		then			! If revision data and debugger info consistent, then accept object file
$			FLINK = FLINK + "," + OBJECT	! Add subroutine to link string
$			ISOUT = ISOUT+1
$			SOUT'ISOUT = SELECT
$			DATOUT'ISOUT = DATIN'JTEST	! Retain revision date
$			DEBOUT'ISOUT = DEBIN'JTEST	! Retain debugger info
$			say "  Existing object file used for ",SELECT
$			goto NEXT_SUB		! Object file is acceptable
$		endif
$	endif
$!
$!------	If source code exists and (rejected) object file exists
$!  - Decide whether to recompile subroutine
$!  - If the object file is accepted by user, set up output info
$!
$	if LIB__ANS .and. .not. REPEAT
$	then						! Object file exists
$		echo LIB__ANS B "  Recompile (YES/NO) ?" YES
$		if .not. LIB__ANS
$		then
$			FLINK = FLINK+","+OBJECT	! Add subroutine to link string
$			ISOUT = ISOUT+1
$			SOUT'ISOUT = SELECT
$			if JTEST .le. ISIN
$			then
$				DATOUT'ISOUT = DATIN'JTEST	! Retain revision date
$				DEBOUT'ISOUT = DEBIN'JTEST	! Retain debugger info
$			else					! Don't recompile
$				DATOUT'ISOUT = " "
$				DEBOUT'ISOUT = " "
$			endif
$			say "  Existing object file used for ",SELECT
$			goto NEXT_SUB
$		endif
$	endif
$!
$!
$!------	Compile source code
$!  -  Compile, purge old object files and set up output info
$!
$	call MKD$FOREXTRA "''SELECT'" COMPILE
$	compile = compile+LIB__ANS
!
$	FLINK = FLINK+","+OBJECT			! Add subroutine to link string
$	say " ... ''compile' ",SOURCE
$	if f$environment("DEPTH") .eq. 1 then @$COM:LIBSUB KEY_CHANGE_EDT 'SOURCE
$	compile/object='OBJECT''SWITCH1' 'SOURCE
$	_CHANGE = 1
$	ISOUT = ISOUT+1
$	SOUT'ISOUT = SELECT
$	DATOUT'ISOUT = f$file_attributes(SOURCE,"RDT")	! Store revision data of source file
$	DEBOUT'ISOUT = DINQ				! Store debugger info
$	@$COM:LIBCOM VPUR 'OBJECT'.OBJ			! Purge old object files
$	goto NEXT_SUB
$!
$!------	 Start linking now that all required object files exist
$!
$ LINK:
$	if NOEXECUTABLE
$	then
$		signal 'P1 I NOEXE "Only object modules created"
$		STATUS = MKD__SUCCESS
$		goto FINAL_EXIT
$	endif
$!	STRING = ""
$	if f$type(LIB__OLB) .nes. "STRING" then LIB__OLB = ""
$ FINAL_LINK:
$	display_list SOUT	" ... will include modules" -
				"     This compilation of main program :"
$	if LIB__OLB .nes. "" then display_comma 'LIB__OLB " ... and generic libraries"
$!
$	if .not. _CHANGE
$	then
$		say " "
$		say "!!                                               !!"
$		say "!!    You did not (re)compile anything, dopey    !!"
$		say "!!                                               !!"
$		echo LIB__ANS B "  Do you want to LINK anyway ?" NO S
$		if .not. LIB__ANS then signal 'P1 E NOLINK "request canceled by dopey"
$		_CHANGE = 1
$	endif
$	call MKD$SET_OLB
$	if CONFIRM_LIB__OLB
$	then
$		LIB__OLB = LIB__ANS-","
$		CONFIRM_LIB__OLB = 0
$		goto FINAL_LINK
$	endif
$	LIB__OLB = LIB__ANS	! Local LIB__OLB starts with , or is empty
$	say " "
$	say " ... Busy linking ... Patience, please" 
$!------
$! Name of existing linker option file or empty
$!
$!	call MKD$MAKE_LINKOPT LIB__ANS
$!	if LIB__ANS .nes. "" then FLINK = LIB__ANS+"/opt"
$!
$	STRING = "link/exe="+EXEDIR+P2+SWITCH2
$	STRING = STRING+" "+FLINK	! If FLINK is very long the link
$	STRING = STRING+LIB__OLB	! ... command may become too long
$	'STRING
$	say " "				! Purge old executable (.EXE) file
$	@$COM:LIBCOM VPUR 'EXEDIR''P2'.EXE
$!
$! Prepare output record for MKD.REC
$!
$ STORE_REC:
$	STATUS = MKD__QUIET .or. $STATUS
$	on warning   then goto MKD_OOPS
$	on control_y then goto MKD_OOPS
$	JTEST = 0
$	RECOUT = ""
$!-------
$! Don't write directly into RECOUT: there are limits to the value of the first
$! argument of REC[A,B] (somewhere near 800). Using FIELD only postpones
$! trouble though. The command RECOUT = RECOUT+FIELD causes an overflow of
$! the command buffer when RECOUT exceeds about 1000 characters.
$!
$ BUILD:				! Record output list SOUT
$	TEMP = SOUT'JTEST		! .. (succesfully compiled modules)
$	FIELD[0,SUBL] := "''TEMP'"
$	TEMP = DATOUT'JTEST
$	FIELD[SUBL,DATL] := "''TEMP'"
$	TEMP = DEBOUT'JTEST
$	FIELD[SUBL+DATL,1] := "''TEMP'"
$	JTEST = JTEST+1
$	RECOUT = RECOUT+FIELD		! Possible command buffer overflow
$!
$	if JTEST .le. ISOUT then goto BUILD
$!
$! Check the input list SIN for unused entries. If the corresponding object file
$! or library still exists then retain the entry in the output list SOUT (NOTE:
$! SIN entries killed at the subroutine/library prompt are identified by
$! SIN'JDEF'="")
$!
$	JDEF = 0				! NOT -1: skip the main program
$ EXTEND:
$	JDEF = JDEF+1
$	if JDEF .le. ISIN			! Loop over input list
$	then
$		if SIN'JDEF' .eqs. "" then goto EXTEND
$!						! Entry was killed at subroutine/lib prompt
$		if f$locate(SIN'JDEF',RECOUT) .ne. f$length(RECOUT) then goto EXTEND
$!						! Entry already on list
$		I = f$locate("/OPT",SIN'JDEF')
$		TEMP = 1
$		if I .ne. f$length(SIN'JDEF')
$		then
$			OBJLIB = f$extract(I,999,SIN'JDEF')
$			TEMP = SIN'JDEF'-OBJLIB+".OPT"
$			if SPARSE .and. -
				f$search( OBJDIR +TEMP) .eqs. "" .and. -
				f$search("$MKD:"+TEMP) .eqs. "" then goto EXTEND
$!						! Kill if no .OPT in OBJDIR and $MKD
$			TEMP = 0
$		endif
$		I = f$locate("/LIB",SIN'JDEF')
$		if I .ne. f$length(SIN'JDEF')	! Entry is an object library
$		then
$			OBJLIB = f$extract(I,999,SIN'JDEF')
$			TEMP = SIN'JDEF'-OBJLIB+".OLB"
$			if SPARSE .and. -
				f$search( OBJDIR +TEMP) .eqs. "" .and. -
				f$search("$MKD:"+TEMP) .eqs. "" then goto EXTEND
$			TEMP = 0
$!						! Kill if no .OLB in OBJDIR and $MKD
$		endif
$		if TEMP				! Entry is an object file
$		then
$			if SPARSE .and. -
				f$search(OBJDIR+SIN'JDEF'+".OBJ") .eqs. "" then goto EXTEND
$		endif				! Kill if no .OBJ file in OBJDIR
$!
$		TEMP = SIN'JDEF			! Record valid entry
$		FIELD[0,SUBL] := "''TEMP'"
$		TEMP = DATIN'JDEF
$		FIELD[SUBL,DATL] := "''TEMP'"
$		TEMP = DEBIN'JDEF
$		FIELD[SUBL+DATL,1] := "''TEMP'"
$!		JPOS = JPOS+UNIT
$		RECOUT = RECOUT+FIELD		! Possible command buffer overflow
$!
$		goto EXTEND
$	endif
$!
$	TEMP = ""				! Write SOUT to RECFILE
$	if ISIN .ge. 0 then TEMP = "/update"
$	write'TEMP'/symbol/error=WRITE_OOPS RECFILE RECOUT
$	if .not. STATUS then goto FINAL_EXIT
$	STATUS = MKD__SUCCESS
$	cd 'EXEDIR
$	goto FINAL_EXIT
$ WRITE_OOPS:
$	STATUS = MKD__QUIET .or. $STATUS
$	signal 'P1 W ERRWRITE "Error writing compilation info to MKD.REC"
$	goto FINAL_EXIT
$ MKD_OOPS:
$	STATUS = MKD__QUIET .or. $STATUS
$ FINAL_EXIT:
$	close/nolog RECFILE
$	exit STATUS
!
!
$ MKD$FOREXTRA:
$	subroutine
$	on warning   then goto FOREXTRA_AFT
$	on control_y then goto FOREXTRA_AFT
!
$	LIB__ANS == ""
$	if f$type(LIB__AXP) .nes. "INTEGER" then exit MKD__SUCCESS
$	if LIB__AXP .eq. 0 then exit MKD__SUCCESS
!
$	TEMP = "$AUX:FORTRAN.TXT"
$	if f$search(TEMP) .eqs. "" then exit MKD__SUCCESS
$	if P2 .eqs. "" then P2 = "COMPILE"
$	P2 = f$edit(P2,"UPCASE")
!
$	open/read TEMP 'TEMP
$ FOREXTRA_NEXT:
$	read TEMP R /error=FOREXTRA_AFT /end_of_file=FOREXTRA_AFT
$	if f$edit(f$element(0,",",R),"UPCASE") .eqs. f$edit(P1,"UPCASE")
$	then
$		PP = f$edit(f$element(2,",",R),"UPCASE")
$		if PP .eqs. "," then PP = "COMPILE"
$		if P2 .eqs. PP then LIB__ANS == f$element(1,",",R)
$		goto FOREXTRA_AFT
$	endif
$	goto FOREXTRA_NEXT
$ FOREXTRA_AFT:
$	close/nolog TEMP
$	exit MKD__SUCCESS
$	endsubroutine
!
$ MKD$MAKE_LINKOPT:
$	subroutine
$	on warning   then goto LINKOPT_ERR
$	on control_y then goto LINKOPT_ERR
$	LINK_OPT = ""
!
$	unique_name = "@$COM:LIBSUB UNIQUE_NAME
!
$	IPOS = 0
$	STRING = f$element(IPOS,",",FLINK)
$	if STRING .nes. ","
$	then
$		unique_name LIB__ANS SYS$SCRATCH:LINK?.OPT;
$		LINK_OPT = LIB__ANS
$		LIB__ANS == ""			! Safety belt
$		create 'LINK_OPT
$		open/append LINK_OPT 'LINK_OPT
$		write LINK_OPT STRING		! Write main program
$	endif
$ NEXT_OBJ:
$	IPOS = IPOS+1
$	STRING = f$element(IPOS,",",FLINK)
$	if STRING .nes. ","
$	then
$		write LINK_OPT STRING		! Write subroutines/libs
$		goto NEXT_OBJ
$	endif
$	close LINK_OPT
$	LIB__ANS == LINK_OPT			! Return linker option file name
$	exit MKD__SUCCESS
$ LINKOPT_ERR:
$	STATUS = MKD__QUIET .or. $STATUS
$	set noon
$	close/nolog LINK_OPT
$	if f$search(LINK_OPT) .nes. "" then delete 'LINK_OPT
$	LIB__ANS == ""
$	exit STATUS
$	endsubroutine
!
$ MKD$SET_OLB:
$	subroutine			! No error handler ?????
$	LIB__ANS == ""
$	if f$type(LIB__OLB) .nes. "STRING" then exit MKD__SUCCESS
$	if LIB__OLB .eqs. "" then exit MKD__SUCCESS
$	if .not. CONFIRM_LIB__OLB
$	then
$		LIB__ANS == ","+LIB__OLB
$		exit MKD__SUCCESS
$	endif
$	say " "
$	say "  Select object libraries to be included in LINKing"
$	STRING = ""
$	I = -1
$ MKD$NEXT_OLB:
$	I = I+1
$	OLB_EL = f$element(I,",",LIB__OLB)
$	if OLB_EL .nes. ","
$	then
$		echo LIB__ANS B "''f$fao("  -----> !40ASInclude (YES/NO)?",OLB_EL)'" YES
$		if LIB__ANS then STRING = STRING+","+OLB_EL
$		goto MKD$NEXT_OLB
$	endif
$	LIB__ANS == STRING
$	exit MKD__SUCCESS
$	endsubroutine
!
!
$ MKDCHECK:
$	P2 = P2-"@"
$	open/read/write/share=write FILE $SAM:MKD.REC /error=CHECK_ERROR
$!
$	SKEY[0,SUBL] := "''P2'"
$	MAT = "GE"
$	if P2 .nes. "" then MAT = "EQ"
$	read/lock FILE/index=0/key="''SKEY'"/match='MAT RECIN -
		/error=CHECK_ERROR /end_of_file=CHECK_EOF
$!
$	I = 0
$ NEXT_REC:
$	I = I+1
$	ISIN	= -1+f$length(RECIN)/UNIT
$	JTEST	= 0
$	JPOS	= 0
$	SELECT	= ""
$ SPLIT:
$	if JTEST .le. ISIN
$	then
$		SIN'JTEST = f$edit(f$extract(JPOS,SUBL,RECIN),"TRIM")
$		JPOS = JPOS+UNIT
$		SELECT = SELECT+","+SIN'JTEST
$		JTEST = JTEST+1
$		goto SPLIT
$	endif
$	say I,">  ",f$extract(1,999,SELECT)
$	if P2 .nes. ""
$	then
$		echo LIB__ANS B "		Delete entry (YES/NO) ?" NO
$		if LIB__ANS
$		then
$			SKEY[0,SUBL] := "''SIN0'"
$			read/delete FILE /index=0/key="''SKEY'" RECIN
$		endif
$		close FILE
$		exit MKD__SUCCESS
$	endif
$!
$	read/lock FILE RECIN /error=CHECK_ERROR /end_of_file=CHECK_EOF
$	goto NEXT_REC
!
$ CHECK_EOF:
$	close FILE
$	signal 'P1 S EOF "end of file $SAM:MKD.REC reached"
$	exit MKD__SUCCESS
!
$ CHECK_ERROR:
$	STATUS = $STATUS
$	signal 'P1 W ERROR "error opening/reading $SAM:MKD.REC file" 'STATUS
$	close/nolog FILE
$	exit MKD__QUIET .or. STATUS
!
$ MKDCHANGE:
$	say ""
$	say "  This option is used to create the initial $SAM:MKD.REC file"
$	say "  or change the size of file name field of the existing version"
!
$	echo LIB__ANS B "  Do you really want to do this (YES/NO)?" NO S
$	if .not. LIB__ANS then signal 'P1 E CANCEL "canceled by user"
!
$	if f$search("$SAM:MKD.REC") .eqs. ""	! File doesn't exist: create and exit
$	then
$		say ""
$		say "  Maximum number of entries will be ''NUNIT'"
$		say "  Size of file name field   will be ''SUBL'"
$		NEW_NUNIT = NUNIT
$		NEW_SUBL  = SUBL
$		call CREATE_MKD_INFO_FILE
$		goto NEW_SUCCESS
$	endif
!
$	say f$fao("!/  Current maximum number of entries is ''NUNIT'")
$	echo LIB__ANS I "  (New) maximum ?" 'NUNIT
$	NEW_NUNIT = LIB__ANS
$	say f$fao("!/  Current size of file name field is ''SUBL'")
$	echo LIB__ANS I "  (New) field size ?" 'SUBL
$	NEW_SUBL = LIB__ANS
!
$	unprot $SAM:MKD.REC
$	rename $SAM:MKD.REC *.OLD
$	on warning	then goto NEW_ERROR
$	on control_y	then goto NEW_ERROR
!
$	call CREATE_MKD_INFO_FILE
!
!
!=======	Copy all records from MKD.OLD to the new MKD.REC
!
$	say "  .. Copying content of $SAM:MKD.OLD into $SAM:MKD.REC"
!
$	open/read/write/share=write	OLD_REC $SAM:MKD.OLD /error=NEW_ERROR
$	open/read/write			NEW_REC $SAM:MKD.REC /error=NEW_ERROR
!
$	SKEY[0,SUBL] := ""
$	MAT = "GE"
$	read/lock OLD_REC /index=0/key="''SKEY'"/match='MAT RECIN -
		 /error=NEW_ERROR /end_of_file=NEW_EOF
$!
$	I = 0
$ NEW_NEXT_REC:
$	I = I+1
$	ISIN	= -1+f$length(RECIN)/UNIT ! # subroutines (=0 for main program only)
$	JTEST	= -1			! Subroutine counter
$	JPOS	=  0			! Position in input record
$	SELECT	= ""
$	RECOUT	= ""			! Clear output record
$	NEW_UNIT = NEW_SUBL+DATL+1
$ NEW_SPLIT:
$	JTEST = JTEST+1
$	if JTEST .le. ISIN		! Loop over all subroutines
$	then
$		FIELDIN = f$extract(JPOS,UNIT,RECIN)
$		JPOS = JPOS+UNIT
$!
$		TEMP  = f$edit(f$extract(0,SUBL,FIELDIN),"TRIM")
$		SELECT = SELECT+","+TEMP! For display to screen only
$		FIELDOUT[0,NEW_SUBL] := "''TEMP'"
$		TEMP = f$extract(SUBL,DATL+1,FIELDIN)
$		FIELDOUT[NEW_SUBL,DATL+1] := "''TEMP'"
$		RECOUT = RECOUT+FIELDOUT! Possible command buffer overflow
$		goto NEW_SPLIT		! Next subroutine
$	endif
$	write/symbol/error=NEW_ERROR NEW_REC RECOUT	! Write to new file
$	say I,">  ",f$extract(1,999,SELECT)		! Display on screen
$!
$	read/lock OLD_REC RECIN /error=NEW_ERROR/end_of_file=NEW_EOF
$	goto NEW_NEXT_REC				! Read next record
!
$ NEW_ERROR:
$	STATUS = $STATUS
$	signal 'P1 W ERROR "error in MKDCHANGE section of MKD" 'STATUS
$	close/nolog OLD_REC
$	close/nolog NEW_REC
$	if f$search("$SAM:MKD.REC") then delete $SAM:MKD.REC;*
$	rename $SAM:MKD.OLD *.REC
$	extprot $SAM:MKD.REC
$	exit MKD__QUIET .or. STATUS
!
$ NEW_EOF:				! EOF reached : copy successful
$	signal 'P1 S EOF "end of file $SAM:MKD.OLD reached"
$	close OLD_REC
$	close NEW_REC
$	delete $SAM:MKD.OLD;*
$ NEW_SUCCESS:
$	extprot $SAM:MKD.REC
$	if LIB__NUNIT .ne. NEW_NUNIT .or. LIB__SUBLENGTH .ne. NEW_SUBL
$	then
$		say " "
$		say "  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
$		say "  !!!!!
$		say "  !!!!!  MODIFICATION OF  >>  $COM:LIBLOGIN.COM <<  REQUIRED
$		say "  !!!!!  New value of global symbol LIB__NUNIT     = ",LIB__NUNIT
$		say "  !!!!!  New value of global symbol LIB__SUBLENGTH = ",LIB__SUBLENGTH
$		say "  !!!!!
$		say "  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
$		say " "
$	endif
$	LIB__NUNIT     == NEW_NUNIT
$	LIB__SUBLENGTH == NEW_SUBL
$	exit MKD__SUCCESS
!
!
$ CREATE_MKD_INFO_FILE:
$	subroutine
$	on warning	then goto FDL_ERROR
$	on control_y	then goto FDL_ERROR
$	quot = """
$	RECL = NEW_NUNIT*(NEW_SUBL+DATL+1)
!
$	say "  .. Creating new info file $SAM:MKD.REC"
$	say "     Size of file name field will be ",NEW_SUBL
$	say "     The record length wil be ",RECL
$	say "     There will be room for ",NEW_NUNIT," entries
$	create SYS$LOGIN:MKD.FDL
$	open/append NEW_FDL SYS$LOGIN:MKD.FDL
$	write NEW_FDL "TITLE	",quot,"RECORDING OF MKD.COM PERFORMANCE",quot
$	write NEW_FDL ""
$	write NEW_FDL "IDENT	",quot," 3-DEC-1990 22:18:40   VAX-11 FDL Editor",quot
$	write NEW_FDL ""
$	write NEW_FDL "SYSTEM"
$	write NEW_FDL "	SOURCE			",quot,"VAX/VMS",quot
$	write NEW_FDL ""
$	write NEW_FDL "FILE"
$	write NEW_FDL "	NAME			",quot,"MKD.REC",quot
$	write NEW_FDL "	ORGANIZATION		indexed"
$	write NEW_FDL ""
$	write NEW_FDL "RECORD"
$	write NEW_FDL "	CARRIAGE_CONTROL	carriage_return"
$	write NEW_FDL "	FORMAT			variable"
$	write NEW_FDL "	SIZE			''RECL'"
$	write NEW_FDL ""
$	write NEW_FDL "AREA 0"
$	write NEW_FDL "	ALLOCATION		3"
$	write NEW_FDL "	BEST_TRY_CONTIGUOUS	yes"
$	write NEW_FDL "	BUCKET_SIZE		3"
$	write NEW_FDL "	EXTENSION		3"
$	write NEW_FDL ""
$	write NEW_FDL "AREA 1"
$	write NEW_FDL "	ALLOCATION		0"
$	write NEW_FDL "	BEST_TRY_CONTIGUOUS	yes"
$	write NEW_FDL "	BUCKET_SIZE		3"
$	write NEW_FDL "	EXTENSION		3"
$	write NEW_FDL ""
$	write NEW_FDL "KEY 0"
$	write NEW_FDL "	CHANGES			no"
$	write NEW_FDL "	DATA_AREA		0"
$	write NEW_FDL "	DATA_FILL		100"
$	write NEW_FDL "	DATA_KEY_COMPRESSION	yes"
$	write NEW_FDL "	DATA_RECORD_COMPRESSION	yes"
$	write NEW_FDL "	DUPLICATES		no"
$	write NEW_FDL "	INDEX_AREA		1"
$	write NEW_FDL "	INDEX_COMPRESSION	yes"
$	write NEW_FDL "	INDEX_FILL		100"
$	write NEW_FDL "	LEVEL1_INDEX_AREA	1"
$	write NEW_FDL "	NAME			",quot,"MAIN PROGRAM",quot
$	write NEW_FDL "	PROLOG			3"
$	write NEW_FDL "	SEG0_LENGTH		''NEW_SUBL'"
$	write NEW_FDL "	SEG0_POSITION		0"
$	write NEW_FDL "	TYPE			string"
$	close NEW_FDL
!
$	create/log/fdl=SYS$LOGIN:MKD.FDL $SAM:MKD.REC	! Create indexed file
$	delete SYS$LOGIN:MKD.FDL;*
$	exit MKD__SUCCESS
!
$ FDL_ERROR:
$	STATUS = $STATUS
$	set noon
$	close/nolog NEW_FDL
$	if f$search("SYS$LOGIN:MKD.FDL") then delete SYS$LOGIN:MKD.FDL;*
$	if f$search("$SAM:MKD.REC") then delete $SAM:MKD.REC;*
$	set on
$	exit MKD__QUIET .or. STATUS
$	endsubroutine
$!
$ MKDHELP:
$	subroutine
$	on warning	then goto HELP_ERROR
$	on control_y	then goto HELP_ERROR
$	say " ... Setting up help info file"
$	HELP_FILE = "SYS$SCRATCH:MKDHELP.TMP"
$!
$! If MKD is called from another command procedure (e.g. WINGTASK) then
$! SYS$INPUT may have been reset to SYS$COMMAND. The caller must save
$! the old SYS$INPUT in a local symbol THISDEV for MKD/HELP to execute properly.
$!
$	if f$type(THISDEV) .eqs. "STRING" then -
		define/nolog/user_mode SYS$INPUT 'THISDEV
$	create 'HELP_FILE
!+
NAME:
	MKD
PURPOSE:
	Compiling and linking of FORTRAN programs (includes optional DEBUG).
INPUTS:
	P1		Name of section to be executed (MK,MKD,MKEXT,MKDEXT)
	LIB__OLB	Global symbol; names of object libraries used in link
			procedure; NOTE: this symbol is most conveniently set
			in the LOGIN.COM file.
	LIB__SUBLENGTH	Global symbol; length of key 0 (field size for the
			subroutine name) in the info file MKD.REC
	$COM		Logical; location of .COM files
	$SAM		Logical; location of MKD.REC file

The following values for P1 are allowed (the remaining arguments refer to a
an MKD call without any qualifiers; see CALLING SEQUENCE for the position of
qualifiers):
> MK:  (compile/link single file; .EXE in parent directory; delete .OBJ)
	P2	(Optional)	Name of main program. If no program is 
		specified, user is prompted (the default choice offered, is the
		value in global symbol LIB_MAIN)
> MKD: (compile/link multiple files; .EXE and .OBJ in parent directory)
	P2	same as for MK (main program name)
	(P2 = "@" and P2="&" have special meaning; see below)
> MKD @'P2
	P2	if omitted, all entries in MKD.REC are listed
		if specified, the corresponding entry is listed. A prompt will
			follow, asking whether the entry should be deleted.
> MKD &		will allow you to create or modify the MKD.REC file.
		If MKD.REC does not exist a new (empty) version is created.
		If MKD.REC exist a new version is created with a new value
			for the field length of key 0 (LIB__SUBLENGTH). The
			content of the old version is copied into the new one
			before it is deleted.

Qualifiers have to be inserted just before the name of the main program (at
the end of the command line if no main program is specified). Qualifiers begin
with a slash `/'. If more than one qualifier is present, they are processed in
the order they appear on the command line. Qualifiers must be separated by a
space. Valid qualifiers are:

	/SRCDIR=dir	directory where source files are located
			(this overrides the $TMP logical and a directory
			 included in the P2 argument)
	/EXEDIR=dir	directory where executable is placed
	/OBJDIR=dir	directory where object files are placed
	/DEBUG		compile/link with the debugger
	/NOEXE		don't produce an executable
	/NOLIB		exclude directories from the LIB__OLB list
	/HELP		display help
	/?		display help
	/GO		skips main program prompt and assumes "#" for 
			subroutine prompt
	/FRESH		same as MKD &
SIDE EFFECTS:
	Deletes entries from the MKD.REC if requested
OUTPUTS:
	LIB__MAIN	Global symbol; updated with name of compiled main
			program (used as default during next run)
	$TMP		Logical; updated with location of source code (used in 
			next run to search for source code)
	FORTRAN executables and object modules
CALLING SEQUENCE:
	@$COM:MKD MK [/qualifiers] [filename]
	@$COM:MKD MKD [/qualifiers] [filename]
	@$COM:MKD MKD @[filename]
	@$COM:MKD MKD &
SIDE EFFECTS:
>	Update/addition of one record in $SAM:MKD.REC with compile/link info
	The contents of the updated record depends on two factors:
	1. It contains all info about the current compilation
	2. If the previous compilation (as registered in the MKD.REC record
	   before the update) contained modules for which the object file still
	   exists they will be retained in the updated record (even if the 
	   module was not explicitly used in the compilation)
>	For MK and MKEXT the object files are dumped in the directory assigned
	to SYS$SCRATCH. The object files will be deleted upon successful 
	completion.
RESTRICTIONS:
>	If MK or MKD is used, executables and object files (for MKD) are placed
	in the parent of the source code directory. Note that this implies,
	that the SOURCE CODE SHOULD NOT BE STORED IN THE LOGIN DIRECTORY, but
	in some subdirectory. If this is a problem use the /OBJDIR and /EXEDIR
	qualifiers to specify where you want to dump the .OBJ and .EXE files.
NOTE FOR DOPES WHO WANT TO MESS WITH THIS THING:
	There was a reason why the values of OBJDIR and EXEDIR are not 
	hardwired into the procedures as some fixed directories.
	This would reduce flexibility, since object/executable files of
	everybody and his mother would end up in the same directory. Using
	logicals only partially alleviates this problem, since every user would
	have to worry about defining (and sometimes redefining) his own
	logicals (in the current setup only LIB__OLB is of concern to the user).
PROCEDURE:
>	All source code (main program and subroutines) MUST be in the same
	directory. The procedure first looks in the current directory for the
	main program source code. If not found, the directory stored
	in the logical $TMP is searched. Once the main program is located
	$TMP is updated to the new directory. Subroutines are searched
	for in the main program directory only.

>	Global symbols MKD and MK are set to the respective calling sequences in
	LIBINIT.COM.

>	The link command includes the libraries in the global symbol LIB__OLB.
	(unless libraries are excluded using the /NOLIB qualifier)

>	For MKD:
	In case the program has to be linked with subroutines, which are not
	contained in the main program file or the libraries, the file(s) with
	the subroutine source code can be entered after the prompt for
	SUBROUTINEs. This option can also be used to override library
	subroutines.

	Object files are created in the parent directory of the source code
	(MKD) or in the directory specified with /OBJDIR. They will not be
	deleted. Old versions are purged.

	The .EXE file will be created in the parent directory of the source 
	code (MKD) or in the directory specified with /EXEDIR. Old versions are
	purged. No .EXE file is created if the /NOEXE qualifier is used.

>	Recording of compilation info for MKD:

	One record of information about the compilation is written to the file
	MKD.REC. For each source code file used the record contains
		1) name of the source code file,
		2) Last modification date of the source code file,
		3) whether or not the DEBUG switch was used in the compilation.
	If the same main program is compiled again information from this record
	is used to decide what to do with existing object files.
	If an object file exist and the modification date from the record is
	the same as for the source file itself, then apparently the source file
	has not been modified since the last compilation. If the debug
	information is consistent too, the object file is used again; if not
	then in case of a main program the source file is recompiled; in case
	of a subroutine, user is asked whether the object file is acceptable
	or not.

>	The subroutine prompts for MKD:

	If a main program is compiled for which compilation information is 
	available from a previous run of MKD or MKDEXT, the subroutines used
	in the previous run will be offered as default choices.

	The % symbol will exit the loop prompting for subroutines and start
	the linking.

	The # symbol will compile all remaining subroutines from the default
	list and link everything without any further prompts. If # is entered
	at the first prompt for a subroutine the same compilation as for the
	previous run results.

	The + symbol operates the same as the # symbol except that, after
	compiling all default subroutines, it will prompt for additional
	subroutines (i.e. it will not proceed with the linking).

	The - symbol will skip the current default subroutine. All existing
	object files for the subroutine will be deleted, and the subroutine
	will not be recorded after the compilation has finished (i.e. the
	subroutine will not be on the default list for the next compilation.

>	Specifying user object libraries.

	It is possible to specify additional object libraries (rather than a
	subroutine) by adding the switch /LIB. Do not specify a directory.
	First the directory where the object files are created (i.e. the parent
	directory for MKD, or the explicitly defined object directory) is
	seached; if not found the directory $LIB (where the LIB__OLB libraries
	are located) is checked.

	The qualifier /INCLUDE=... can be included next to the /LIB qualifier.

>	The qualifiers for MKD.
	/NOEXE		if used, files will only be compiled, not linked.
			I.e. no executable will be created. In addition,
			the compilation info is not saved in MKD.REC
	/NOLIB		if used, prompts will follow for all libraries in
			the LIB__OLB symbol. Each library can be individually
			excluded from the linking (by default all libraries
			in LIB__OLB are included)
	/DEBUG		will include the /DEBUG qualifier in compile and
			link commands. The resulting executable will run
			using the VAX debugger.
	/HELP or /?	will pull this information section from the source
			code file and enter the editor in readonly mode.
	/SPARSE		if set, unused entries from a previous compilation
			will not be remembered, UNLESS source code file or
			object file still exists. By default, unused
			entries are retained, unless explicitly killed at the
			subroutine/library prompt.

>	The MKD.REC file (where the compilation info is stored)

	MKD.REC is an indexed file and was created using the file MKD.FDL
	in the CREATE/FDL command (the file MKD.FDL is created and deleted
	after use when the option `MKD &' is used). The maximum recordlength
	is at present 660, i.e. information about a maximum of 15 files (each
	using 44 characters) can be stored. If this is not enough, create an
	object library and add this to the LIB__OLB global symbol. Enter only
	the subroutines that are actually being changed and require continuous
	recompilation at the SUBROUTINE prompt.

	Though not strictly necessary, the MKD.REC file should be cleaned up
	every now and then. The command MKD @ will display the entire content
	of MKD.REC. The command MKD @PROGNAME will display the entry for 
	program PROGNAM, followed by a prompt to delete the entry or not.
!-
$	define/user_mode SYS$INPUT LIB$ECHO
$	edit/edt/readonly 'HELP_FILE
$ HELP_ERROR:
$	set noon
$	delete 'HELP_FILE';*
$	set on
$	endsubroutine


======== Old code for argument processing.
! Extract arguments
!
$ OLD_LIBARG:
$	ARG = ""
$ FIND_SWITCHES:				! Check argument P1..P8 for
$	I = 0					! .. switches starting with /
$ NEXT_P:
$	I = I+1
$ SAME_P:
$	JPOS = I+1
$	if P'I .eqs. "" .and. P'JPOS .nes. ""
$	then
$		ISIN = I			! P'ISIN just tested empty
$ SHIFT_P:					! Fill P'ISIN by shifting following P-args
$		JPOS = ISIN			! P'JPOS is empty
$		if JPOS .lt. 8
$		then
$			ISIN = JPOS+1		! P'ISIN is arg following P'JPOS
$			if P'ISIN .nes. ""	! P'ISIN not empty: shift
$			then
$				P'JPOS = P'ISIN	! Copy P'ISIN into empty P'JPOS
$				P'ISIN = ""	! Make sure P'ISIN is empty
$				goto SHIFT_P
$			endif
$		endif
$	endif
$	if P'I .nes. ""				! If argument not empty
$	then
$		JPOS = f$locate("/",P'I)	! Check for 1st slash
$		if JPOS .lt. f$length(P'I)	! If slash found
$		then				! Check for 2nd slash
$			ISIN = JPOS+1+f$locate("/",f$extract(JPOS+1,999,P'I) )
$			if ISIN .gt. JPOS+1
$			then			! Extract switch
$				ARG = ARG+f$extract(JPOS,ISIN-JPOS,P'I)
$			endif			! Remove switch from P'I
$			P'I = f$extract(0,JPOS,P'I)+f$extract(ISIN,999,P'I)
$			goto SAME_P		! There may be another switch in P'I
$		endif
$		if I .lt. 8 then goto NEXT_P
$	endif
$!
$!-- End args processing
$!
$	return

MODIFICATION HISTORY:

1989-1990, Paul Hick (MPAE,UCSD); Once upon a time ...
AUG-1991, Paul Hick (ARC) ; introduced MKD.REC file to store compilation info
	for recall on next recompilation of same program
OCT-1991, Paul Hick (UCSD); added /symbol switch to write statement which
	adds/updates record in MKD.REC file
NOV-1991; added MKEXT and MKDEXT; adds possibility to
	explicitly set directories for storing objects and executables
JUL-1992; added MKDCHECK to maintain MKD.REC file
DEC-1992; added symbol LANGS for handling different 
	languages. LANGS contains a list of acceptable languages. At present
	LANGS = "FOR,PAS,MAR,CLD". Symbols FOR,PAS,MAR,CLD contain the compile
	commands for each language (note that these symbols are identical to
	the default file types for each language)
???-1993; added option to enter `personal' object libraries
	at the 'subroutine' prompt. The personal library is identified by the
	'/lib' switch and is searched for in the same directory as the object
	files. (see JUN-1993 update)
JUN-1993; added C as acceptable language. The symbol LANGS is
	now = "FOR,C,PAS,MAR,CLD". A symbol C was added to contain the compile
	command for the CC compiler
JUN-1993; personal object libraries are now searched for in
	two directories: first the assigned directory for object files is
	searched, then the $LIB directory.
JUN-1993; added the option to exclude object libraries listed
	in the default list LIB__OLB. If the second argument P2 is "/NOLIB" the
	display of the link info is followed by prompts to in-/exclude the
	LIB__OLB libraries.
JUL-1993; the specification of personal libraries can now
	contain a '/include=module' part. BUT: since the total entry must be
	less/equal SUBL (=20) characters to be stored correctly in the MKD.REC
	file, this option is of limited usefulness
JUL-1993; added option to change the field size for the
	subroutine file name entry in MKD_REC (key 0 of that file). The field
	size is now stored in global symbol LIB__SUBLENGTH.
	The option is called by `MKD &'. If MKD.REC does not exist then MKD
	will automatically branch to this option and create the file. The
	option can also be used to refresh the MKD.REC file, i.e. reclaim the
	space occupied by deleted entries by rewriting the entire file.
	NOTE: if the field size is changed then the global symbol LIB__SUBLENGTH
	must be redefined in LIBLOGIN.COM.
JUL-1993; added the ADD (+) option: repeat previous
	compilation, then stop at subroutine prompt.
OCT-1993;
      - Added the kill (-) option: a presented default subroutine can be
	explicitly excluding by typing -. The subroutine/library name will
	not be linked and is not stored in RECFILE. Object files are deleted
	(if they still exist). Note that this is different from simply not
	using a default subroutine from the input list: as long as object
	files exist these entries will be retained in RECFILE.
      - BUG removed: unused object libraries (still in the SIN list from a
	previous compilation) were dropped from the SOUT list if they were
	located in $LIB. This was particularly annoying if a compilation
	was interrupted by a fatal compilation error in a subroutine
	processed prior to the library. After correcting the error in the
	offending subroutine and recompiling the library had to be explicitly
	added to the SOUT list (i.e. the repeat mode could not be used).
      - The ADD (+) and REPEAT mode can now be activated at any subroutine/
	library prompts (used to be possible only at the very first prompt.
      - Added a loop to check whether a selected subroutine/library is
	already present in the SOUT list (to avoid duplicate entries in the
	final link command)
NOV-1993; Added an option to produce only object files. If the second argument
	is "/NOEXE" then files will be compiled only. No information is stored
	in MKD.REC
NOV-1993; Added help option. If the second argument is "/?" or "/HELP" then
	the whole info section, except the modification history, is written
	into a scratch file, which is opened using the EVE editor in
	readonly mode. The scratch file is deleted on exit.
JUN-1994; Improved handling of qualifier (/something). Switches can now preceed
	or follow the program name, and do not have to be separated anymore by
	spaces on the command line.
NOV-1994; The symbols LOGINDISK and SCRATCHDISK are now directly extracted from
	the logicals SYS$LOGIN and SYS$SCRATCH (used to be defined as global
	symbols)
DEC-1994; Added a check of the directories where object and executable files
	are stored. If one of these happens to be the device root directory
	[000000] then the compilation is aborted.
MAR-1995; Added the option to include linker option files and the subroutine
	prompt. The linker option file MUST have the extension .OPT and
	is searched for in the same way as object libraries.
OCT-1995; Introduced the logical $MKD to be used as a search path. It
	replaces the use of $LIB as alternative location of source code and
	object libraries. $MKD can be a list of multiple directories. By
	default it is set to the same directory as $LIB.
DEC-1995;
      -	Introduced symbol LIB__NUNIT representing the maximum number of 
	entries that are stored in the file MKD.REC (includes the main 
	program).
	The symbol is used to warn user that the maximum number of subroutines
	has been entered. In combination with LIB__SUBLENGTH it is also used
	to determine the record length of a new MKD.REC file.
	The current values of LIB__SUBLENGTH (=27) and LIB__NUNIT (=19) push
	the limits on CASS01. The record length of MKD.REC is now 969.
	For longer records problems arise when the command buffer overflows.
	Several potential places where this may occur are marked with the
	comment `! Possible command buffer overflow'.
      - If the number of subroutines is large, then the link command may
	become too long. This can be avoided by creating a linker option file
	containing all the files to be linked together. The subroutine
	MKD$MAKE_LINKOPT was introduced to accomplish. The option is currently
	disabled but may come in handy sometime (MKD$MAKE_LINKOPT creates
	a temporary linker option file in SYS$SCRATCH).
JUL-1997:
      - Introduced a kludge to be able to deal with some old HELIOS programs
	which need the /noalign switch. The file $AUX:FORTRAN.TXT is now read
	to determine what extra switches are needed on the compile command.
DEC-1997:
      - In the compilation section a call to LIBSUB KEY_CHANGE_EDT is made to
	set up PF3 (* key on numeric pad) with the edit command for the last
	compiled source code file. PF3 is set up only if MKD is called
	directly from DCL (depth=1). PF3 is NOT set up if MKD is called from
	another command procedure (depth>1).
DEC-1997:
      - Use of $AUX:FORTRAN.TXT (see JUL-1997) extended to deal with special 
	compile and link requests for main and subprograms.
	FORTRAN.TXT contains records in any of the following three forms:
		filename,/switches
		filename,/switches,COMPILE
		filename,/switches,LINK
	The first two will result in the string '/switches' being added to
	the compile command. The third adds it to the link command.
	If a main program requires both compile and link switches separate
	records for each set of switches must be added.
JUN-1999:
      - Removed bug in subroutine MKD$FOREXTRA: the error label FOREXTRA_ERR
	used in 'on warning' and 'on control_y'	doesn't exist. Replaced it
	by FOREXTRA_AFT