PROGRAM DALUFD
C	==============
C
C
C  COMPONENT:	DALUFD
C  ---------
C
C  DATE:	27-NOV-79
C  ----
C
C  AUTHOR:	GR JOHNSON
C  ------	BATTELLE NORTHWEST
C		P O BOX 999
C		RICHLAND WA 99352
C
C  SOURCE:	FORTRAN IV-PLUS
C  ------
C
C
C
C  DESCRIPTION:
C  -----------
C
C	THE "DALUFD" UTILITY CREATES A USER FILE DIRECTORY (UFD) ON THE
C  SPECIFIED VOLUME, AND AN OPTIONAL ASSOCIATED ENTRY IN THE VOLUME ALLOCATION
C  FILE.  THE UTILITY IS DESIGNED TO BE COMPATIBLE WITH THE STANDARD RSX-11/IAS
C  "UFD" COMMAND (REFER TO THE IAS MCR USER'S GUIDE, PAGE 7-67).
C
C
C		MCR> UFD dev:uic[/quals]
C
C		WHERE;
C
C		dev:		IS THE DEVICE ON WHICH THE DIRECTORY IS
C				TO BE CREATED.
C
C		uic		IF THE UIC OF THE UFD BEING CREATED.
C
C		/quals		IS ONE OR MORE OF THE FOLLOWING QUALIFIERS:
C
C			/PRO=[system,owner,group,world]
C
C			/ALLOC=number-of-entries
C
C

C	I N S T A L L A T I O N
C	=======================
C
C
C  BUILD THE DISK ALLOCATION UTILITIES
C  -----------------------------------
C
C		PDS> @DAL.BLD
C
C  REMOVE THE "...UFD" SYSTEM TASK
C  -------------------------------
C
C		PDS> REMOVE ...UFD
C
C  INSTALL THE DISK ALLOCATION UTILITIES
C  -------------------------------------
C
C		PDS> INSTALL/TASK:$$$DAL [11,1]DAL
C		PDS> INSTALL/TASK:...UFD [11,1]DALUFD
C
C

C	G L O B A L   P A R A M E T E R S   A N D   V A R I A B L E S
C	=============================================================
C
C
C
	INCLUDE 'VAFILE.COM/NOLIST'
C
C
C	L O C A L   P A R A M E T E R S   A N D   V A R I A B L E S
C	===========================================================
C
C
C
	PARAMETER UFDLUN = 1		! MDFILE LUN
	PARAMETER VAFLUN = 1		! VAFILE LUN
	PARAMETER TTYLUN = 5		! TTY I/O LUN
C
	PARAMETER EOS = 0		! END-OF-STRING
C
	BYTE	  ICMD(128)		! INPUT COMMAND LINE BUFFER
	INTEGER	  ILEN			! INPUT COMMAND LINE LENGTH
	INTEGER	  IPNT			! INPUT COMMAND LINE POINTER
C
	LOGICAL	  PROQ			! "/PRO=" QUALIFIER
	LOGICAL	  ALOQ			! "/ALLOC=" QUALIFIER
	LOGICAL	  OCTQ			! "/ALLOC=" QUALIFIER OCTAL VALUE
C
	BYTE	  UFDDEV(2)		! SPECIFIED UFD DEVICE
	INTEGER	  UFDUNT		! SPECIFIED UFD UNIT
	INTEGER	  UFDUIC		! SPECIFIED USER-ID
	BYTE	  UFDUFD(10)		! SPECIFIED USER DIRECTORY
	BYTE	  UFDPRO(22)		! SPECIFIED UFD PROTECTION
	INTEGER	  UFDALO		! SPECIFIED UFD INITIAL SIZE
C
	BYTE	  UFDFNM(32)		! UFD FILENAME BUFFER
C
	INTEGER	  LUNBUF(6)		! GETLUN DIRECTIVE BUFFER
C
	INTEGER*4 GETSIZ		! GETSIZ FUNCTION (I*4)
	INTEGER*4 UFDSIZ		! UFD ALLOCATION (BLOCKS)
C
C

C	I N I T I A L I Z A T I O N
C	===========================
C
C
C
C  INITIALIZE FCS ERROR PROCCESSING
C
 10	CALL IOERRS
C
C
C
C  VERIFY COMMAND PRIVILEGE
C
	CALL CHKPRV('[1,1]')
C
C
C
C  INITIALIZE COMMAND PARAMETERS
C
	UFDDEV(1)=EOS
	UFDDEV(2)=EOS
C
	UFDUNT=0
C
	UFDUIC=0
	UFDUFD(1)=EOS
C
	UFDPRO(1)=EOS
C
	UFDALO=0
C
C

C	P A R S E   U F D   C O M M A N D   L I N E
C	===========================================
C
C
C
C  FETCH COMMAND LINE -- PARSE COMMAND NAME
C
 20	CALL GCMD(TTYLUN,ICMD,ILEN)
C
	CALL COMPAR(ICMD,'UFD',IPNT)
	IF(IPNT.LE.3) STOP 'DALUFD installed with unknown task name'
C
	IF(ICMD(IPNT).EQ.EOS) GO TO 2002
	IF(ICMD(IPNT).EQ.' ') GO TO 2004
	GO TO 90000
C
C
C
C  PROMPT AND INPUT COMMAND LINE (IF NECCESSARY)
C
 2002	CALL GCMDP(TTYLUN,'UFD> ',ICMD,ISW)
	IF(ISW.LT.0) CALL EXIT
	IF(ISW.EQ.0) GO TO 2002
	IPNT=0
C
C
C
C  PARSE "DEVICE"
C
 2004	IPNT=IPNT+1
C
	UFDDEV(1)=ICMD(IPNT)
	IPNT=IPNT+1
	UFDDEV(2)=ICMD(IPNT)
	IPNT=IPNT+1
C
	UFDUNT=0
C
 2006	IF(ICMD(IPNT).LT.'0') GO TO 2008
	IF(ICMD(IPNT).GT.'7') GO TO 2008
	UFDUNT=8*UFDUNT+(ICMD(IPNT)-'0')
	IPNT=IPNT+1
	GO TO 2006
C
 2008	IF(ICMD(IPNT).NE.':') GO TO 90400
C
	CALL ASNLUN(UFDLUN,UFDDEV,UFDUNT,ISW)
	IF(ISW.NE.1) GO TO 90400
C
	CALL GETLUN(UFDLUN,LUNBUF)
	ITMP="140010
	IF(LUNBUF(3).NE.ITMP) GO TO 90500
C
C
C
C  PARSE "UFD"
C
	IPNT=IPNT+1
C
	DO 2010 ITMP=1,9
	UFDUFD(ITMP)=ICMD(IPNT)
	IPNT=IPNT+1
	IF(UFDUFD(ITMP).EQ.']') GO TO 2012
 2010	CONTINUE
	GO TO 90600
C
 2012	UFDUFD(ITMP+1)=EOS
C
	CALL CVTUIC(UFDUFD,UFDUIC,-1,ISW)
	IF(ISW.NE.0) GO TO 90600
C
C
C
C  PARSE OPTIONAL UFD PARAMETERS
C
 2014	IF(ICMD(IPNT).EQ.EOS) GO TO 30
	IF(ICMD(IPNT).NE.'/') GO TO 90200
C
	IPNT=IPNT+1
C
	CALL COMPAR(ICMD(IPNT),'PRO',NCHR)
	IF(NCHR.GT.1) GO TO 2016
C
	CALL COMPAR(ICMD(IPNT),'ALLOC',NCHR)
	IF(NCHR.GT.1) GO TO 2022
C
	GO TO 90100
C
C
C
C >>> "/PRO=" QUALIFIER
C
 2016	IPNT=IPNT+NCHR-1
	IF(ICMD(IPNT).NE.'=') GO TO 90200
C
	IF(PROQ) GO TO 90300
	PROQ=.TRUE.
C
	IPNT=IPNT+1
	IF(ICMD(IPNT).NE.'[') GO TO 90200
C
	DO 2018 ITMP=1,21
	UFDPRO(ITMP)=ICMD(IPNT)
	IPNT=IPNT+1
	IF(UFDPRO(ITMP).EQ.']') GO TO 2020
 2018	CONTINUE
	GO TO 90200
C
 2020	UFDPRO(1)=     '('
	UFDPRO(ITMP)=  ')'
	UFDPRO(IPNT+1)=EOS
C
	CALL PROTEC(UFDPRO,,ISW)
	IF(ISW.LT.0) GO TO 90200
C
	GO TO 2014
C
C
C
C >>> "/ALLOC=" QUALIFIER
C
 2022	IPNT=IPNT+NCHR-1
	IF(ICMD(IPNT).NE.'=') GO TO 90200
C
	IF(ALOQ) GO TO 90300
	ALOQ=.TRUE.
C
	IPNT=IPNT+1
	IF(ICMD(IPNT).LT.'0') GO TO 90200
	IF(ICMD(IPNT).GT.'9') GO TO 90200
C
	UFDALO=0
	OCTQ=.TRUE.
C
C
 2024	IF(ICMD(IPNT).LT.'0') GO TO 2026
	IF(ICMD(IPNT).GT.'7') OCTQ=.FALSE.
	IF(ICMD(IPNT).GT.'9') GO TO 2026
C
	UFDALO=10*UFDALO+(ICMD(IPNT)-'0')
	IPNT=IPNT+1
	GO TO 2024
C
C
 2026	IF(ICMD(IPNT).NE.'.') GO TO 2028
	IPNT=IPNT+1
	GO TO 2014
C
C
 2028	IF(.NOT.OCTQ) GO TO 90200
C
	IDEC=UFDALO
	IOCT=0
C
	DO 2030 I=4,0,-1
	IOCT=8*IOCT+IDEC/(10**I)
	IDEC=IMOD(IDEC,(10**I))
 2030	CONTINUE
C
	UFDALO=IOCT
	GO TO 2014
C
C

C	C R E A T E   U S E R   F I L E   D I R E C T O R Y
C	===================================================
C
C
C
C  ASSIGN LOGICAL UNIT
C
 30	CALL ASNLUN(UFDLUN,UFDDEV,UFDUNT)
C
C
C
C  TEST FOR EXISTING UFD -- (FETCH DIRECTORY ALLOCATION)
C
	CALL CVTUIC(UFDUFD,UFDUIC,0,ISW)
C
	UFDSIZ=GETSIZ(UFDLUN,UFDUFD,ISW)
C
	IF(ISW.EQ.-26) GO TO 3002
	IF(ISW.LT.0)   GO TO 90700
		       GO TO 90800
C
C
C
C  INITIALIZE UFD OWNERSHIP
C
 3002	CALL PROTEC(,UFDUFD)
C
C
C
C  INITIALIZE UFD FILE NAME
C
	CALL CVTUIC(UFDUFD,UFDUIC,3,ISW)
C
	CALL CONCAT(UFDFNM,'[0,0]',UFDUFD,'.DIR;1')
C
C
C
C  INITIALIZE UFD "INITIALSIZE" PARAMETER -- (CONVERT # OF ENTRIES TO BLOCKS)
C
	UFDALO=(UFDALO+32)/32
C
C
C
C  CREATE USER FILE DIRECTORY
C
	OPEN(	UNIT=UFDLUN,
	2	NAME=UFDFNM,
	3	TYPE='NEW',
	4	INITIALSIZE=UFDALO,
	5	ACCESS='DIRECT',RECORDSIZE=4,
	6	ERR=90900)
C
	CLOSE(UNIT=UFDLUN)
C
C

C	C R E A T E   V O L U M E   A L L O C A T I O N   E N T R Y
C	===========================================================
C
C
C
C  ASSIGN LOGICAL UNIT
C
40	CALL ASNLUN(VAFLUN,UFDDEV,UFDUNT)
C
C
C
C  OPEN VOLUME ALLOCATION FILE -- (EXIT IF VAF NOT INITIALIZED)
C
	CALL NOLOCK(VAFLUN)
C
 4002	OPEN(	UNIT=VAFLUN,
	2	NAME=VAFFNM,
	3	TYPE='OLD',
	4	ACCESS='DIRECT',RECORDSIZE=2,
	5	SHARED,
	6	ERR=4004)
C
	READ(VAFLUN'1,ERR=91100) VAFDEF
	GO TO 4006
C
 4004	CALL ERRSNS(ISW,IFCS)
	IF(ISW.EQ.29) CALL EXIT
	IF(ISW.NE.30) GO TO 91000
	IF(IFCS.NE.-27.AND.IFCS.NE.-29) GO TO 91000
	CALL WAIT(1,2,ISW)
	GO TO 4002
C
C
C
C  SCAN VOLUME ALLOCATION FILE FOR SPECIFIED UFD
C
 4006	VAFERP=0
C
	DO 4008 VAFPNT=VAFFRP,VAFLRP
	READ(VAFLUN'VAFPNT,ERR=91100) VAFREC
C
	IF(VAFUIC.EQ.UFDUIC) CALL EXIT
C
	IF((VAFUIC.EQ.0).AND.(VAFERP.EQ.0)) VAFERP=VAFPNT
C
 4008	CONTINUE
C
	IF(VAFERP.EQ.0) VAFERP=VAFPNT
C
C
C
C  UPDATE VOLUME ALLOCATION FILE -- (VAF ENTRY NOT FOUND)
C
	VAFISW=VAFUNL
	VAFUIC=UFDUIC
	VAFLIM=DEFLIM
C
	WRITE(VAFLUN'VAFERP,ERR=91200) VAFREC	! APPEND/INSERT VAF ENTRY
C
	IF(VAFERP.LE.VAFLRP) GO TO 4010
C
	VAFLRP=VAFERP
	WRITE(VAFLUN'1,ERR=91200) VAFDEF	! UPDATE DEFAULT VAF ENTRY
C
C
C
C  CLOSE VOLUME ALLOCATION FILE AND EXIT
C
 4010	CLOSE(UNIT=VAFLUN)
C
	CALL EXIT
C
C

C	P R O C E S S   F A T A L   E R R O R S
C	=======================================
C
C
C
90000	WRITE(TTYLUN,90001)
90001	FORMAT(' Illegal command'/)
	CALL EXIT
C
90100	WRITE(TTYLUN,90101)
90101	FORMAT(' DAL -- Unknown qualifier'/)
	CALL EXIT
C
90200	WRITE(TTYLUN,90201)
90201	FORMAT(' DAL -- Invalid qualifier'/)
	CALL EXIT
C
90300	WRITE(TTYLUN,90301)
90301	FORMAT(' DAL -- Inconsistant qualifier'/)
	CALL EXIT
C
90400	WRITE(TTYLUN,90401)
90401	FORMAT(' DAL -- Invalid device code'/)
	CALL EXIT
C
90500	WRITE(TTYLUN,90501)
90501	FORMAT(' DAL -- Not a directory device'/)
	CALL EXIT
C
90600	WRITE(TTYLUN,90601)
90601	FORMAT(' DAL -- Invalid UFD'/)
	CALL EXIT
C
90700	WRITE(TTYLUN,90701)
90701	FORMAT(' DAL -- Fatal directory error'/)
	CALL EXIT
C
90800	WRITE(TTYLUN,90801)
90801	FORMAT(' DAL -- UFD already exits'/)
	CALL EXIT
C
90900	WRITE(TTYLUN,90901)
90901	FORMAT(' DAL -- UFD create error'/)
	CALL EXIT
C
91000	WRITE(TTYLUN,91001)
91001	FORMAT(' DAL -- VAF open error'/)
	CALL EXIT
C
91100	WRITE(TTYLUN,91101)
91101	FORMAT(' DAL -- VAF read error'/)
	CALL EXIT
C
91200	WRITE(TTYLUN,91201)
91201	FORMAT(' DAL -- VAF write error'/)
	CALL EXIT
C
C
	END