SUBROUTINE DALNEW C C C COMPONENT: DALNEW -- ADD VOLUME ALLOCATION ENTRY AND CREATE UFD C C DATE: 27-NOV-79 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 DESCRIPTION: C C ROUTINE "DALNEW" CREATES A NEW USER FILE DIRECTORY (UFD) AND AN C ASSOCIATED ENTRY IN THE VOLUME ALLOCATION FILE. C C THE VOLUME TO BE UPDATED IS SPECIFIED BY INITIALIZING VARIABLES C "VAFDEV" AND "VAFUNT" IN THE COMMON BLOCK "VAFILE". THE USER DIRECTORY C TO BE CREATED IS SPECIFIED BY INITIALIZING THE VARIABLE "VAFUIC". C C THE ALLOCATION LIMIT TO BE ENTERED FOR THE USER DIRECTORY IS C SPECIFIED BY INITIALIZING VARIABLE "VAFLIM" IN THE COMMON BLOCK "VAFILE". C A NEGATIVE VALUE FOR VAFLIM INDICATES THE UFD IS TO MAINTAIN "UNLIMITED" C PRIVILEGES. A ZERO VALUE INDICATES THE VOLUME DEFAULT IS TO BE ENTERED C FOR THE UFD. 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 INCLUDE 'VAFILE.COM/NOLIST' ! VOLUME ALLOCATION FILE 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 PARAMETER VAFLUN = 1 ! VAFILE LUN PARAMETER TTYLUN = 5 ! TERMINAL I/O LUN C INTEGER DALUIC ! SPECIFIED USER DIRECTORY INTEGER*4 DALLIM ! SPECIFIED ALLOCATION LIMIT C BYTE UFDNAM(32) ! UFD FILENAME BUFFER C INTEGER*4 GETSIZ ! GETSIZ FUNCTION (I*4) INTEGER*4 UFDSIZ ! DIRECTORY SIZE (BLOCKS) C C C P R E L I M I N A R Y C C C C INITIALIZE DEFAULT VAF ENTRY C 10 VAFFAR=2 VAFLAR=2 DEFLIM=1000 ! DEFAULT DEFLIM C C C C INITIALIZE LOCAL UFD AND UFD LIMIT BUFFERS C DALUIC=VAFUIC DALLIM=VAFLIM 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 ASSIGN LOGICAL UNIT C 20 CALL ASNLUN(VAFLUN,VAFDEV,VAFUNT) C C C C TEST FOR EXISTING UFD -- (FETCH DIRECTORY ALLOCATION) C CALL CVTUIC(VAFUFD,VAFUIC,0,ISW) C UFDSIZ=GETSIZ(VAFLUN,VAFUFD,ISW) C IF(ISW.EQ.-26) GO TO 2004 IF(ISW.LT.0) GO TO 90000 C C C C OUTPUT WARNING MESSAGE -- (UFD EXISTS) C WRITE(TTYLUN,2002) 2002 FORMAT(' UFD already exists') C GO TO 30 C C C C INITIALIZE UFD OWNERSHIP C 2004 CALL PROTEC(,VAFUFD) C C C C INITIALIZE UFD FILE NAME C CALL CVTUIC(VAFUFD,VAFUIC,3,ISW) C CALL CONCAT(UFDNAM,'[0,0]',VAFUFD,'.DIR;1') C C C C CREATE USER FILE DIRECTORY C OPEN(UNIT=VAFLUN,NAME=UFDNAM,TYPE='NEW',ACCESS='DIRECT', 2 RECORDSIZE=4,INITIALSIZE=1,ERR=90100) CLOSE(UNIT=VAFLUN) 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 ASSIGN LOGICAL UNIT C 30 CALL ASNLUN(VAFLUN,VAFDEV,VAFUNT) C C C C OPEN VOLUME ALLOCATION FILE C CALL NOLOCK(VAFLUN) C 3002 OPEN(UNIT=VAFLUN,NAME=VAFFIL,TYPE='OLD',ACCESS='DIRECT', 2 RECORDSIZE=2,EXTENDSIZE=2,ERR=3004) READ(VAFLUN'1,ERR=90400) VAFDEF GO TO 3006 C 3004 CALL ERRSNS(ISW,IFCS) IF(ISW.EQ.29) GO TO 90200 IF(ISW.NE.30) GO TO 90300 IF(IFCS.NE.-27.AND.IFCS.NE.-29) GO TO 90300 CALL WAIT(1,2,ISW) GO TO 3002 C C C C SCAN VOLUME ALLOCATION FILE FOR SPECIFIED UFD C 3006 VAFNAR=0 C DO 3008 VAFPNT=VAFFAR,VAFLAR READ(VAFLUN'VAFPNT,ERR=90400) VAFREC C IF(VAFUIC.EQ.DALUIC) GO TO 3010 C IF((VAFUIC.EQ.0).AND.(VAFNAR.EQ.0)) VAFNAR=VAFPNT C 3008 CONTINUE C IF(VAFNAR.EQ.0) VAFNAR=VAFPNT GO TO 3014 C C C C OUTPUT WARNING MESSAGE -- (VAF ENTRY FOUND) C 3010 WRITE(TTYLUN,3012) 3012 FORMAT(' Existing VAF entry updated') C VAFNAR=VAFPNT C C C C UPDATE VOLUME ALLOCATION FILE C 3014 VAFISW=VAFUNL VAFUIC=DALUIC VAFLIM=DALLIM IF(VAFLIM.EQ.0) VAFLIM=DEFLIM C WRITE(VAFLUN'VAFNAR,ERR=90500) VAFREC ! APPEND/INSERT VAF ENTRY C IF(VAFNAR.LE.VAFLAR) GO TO 3016 C VAFLAR=VAFNAR WRITE(VAFLUN'1,ERR=90500) VAFDEF ! UPDATE DEFAULT VAF ENTRY C C C C CLOSE VOLUME ALLOCATION FILE AND RETURN TO CALLER C 3016 CLOSE(UNIT=VAFLUN) C C RETURN C C C P R O C E S S F A T A L E R R O R S C C C 90000 WRITE(TTYLUN,90001) 90001 FORMAT(' DAL -- Fatal directory error'/) CALL EXIT C 90100 WRITE(TTYLUN,90101) 90101 FORMAT(' DAL -- UFD create error'/) CALL EXIT C 90200 WRITE(TTYLUN,90201) 90201 FORMAT(' Volume not initialized for directory allocation'/) CALL EXIT C 90300 WRITE(TTYLUN,90301) 90301 FORMAT(' DAL -- VAF open error'/) CALL EXIT C 90400 WRITE(TTYLUN,90401) 90401 FORMAT(' DAL -- VAF read error'/) CALL EXIT C 90500 WRITE(TTYLUN,90501) 90501 FORMAT(' DAL -- VAF write error'/) CALL EXIT C C END