C IOFILE.FOR C FUNCTION IOFILE (LUN, TYPE, NAME, ISIZE) C C---------------------------------------------------------------------- C C 'IOFILE' IS AN RT-11 FORTRAN FUNCTION THAT OPENS A FILE ON THE C SPECIFIED LOGICAL UNIT. THE USER MAY BE OPTIONALLY QUERIED ON C THE CONSOLE FOR THE FILE NAME. C C LUN IS THE DESIRED LOGICAL UNIT C C TYPE IS AN ASCII STRING SPECIFYING THE TYPE OF FILE TO C BE OPENED: C 'OLD' MEANS AN OLD FILE. THE FILE IS OPENED FOR READING C ONLY. AN ERROR WILL OCCUR AND THE FILE WILL NOT BE C OPENED IF THE FILE DOES NOT EXIST. C 'NEW' MEANS A NEW FILE. THE FILE IS OPENED FOR WRITING C AND READING. AN ERROR WILL OCCUR AND THE FILE WILL C NOT BE OPENED IF THE FILE ALREADY EXISTS. C 'UNK' MEANS AN UNKNOWN FILE. IF THE FILE DOES NOT EXIST C A NEW FILE IS OPENED. IF THE FILE EXISTS, IT IS C REOPENED (CAUTION: YOU CAN LOOSE AN OLD FILE C THIS WAY). C C NAME IS A STRING ARRAY CONTAINING THE FILE NAME OF THE C FILE TO BE OPENED. AN EXAMPLE OF THE CORRECT FORM OF C THE STRING IS 'DX2TEST DAT'. IF YOU WISH TO BE QUERIED C ON THE CONSOLE FOR A FILE NAME, SET NAME EQUAL TO 0. C C ISIZE IS THE NUMBER OF BLOCKS DESIRED FOR A NEW FILE, OR C = 0 GETS HALF OF BIGGEST CONTIGUOUS SPACE ON DISK C = -1 GETS BIGGEST CONTIGUOUS SPACE ON DISK C C IOFILE WILL BE RETURNED WITH A VALUE AS FOLLOWS: C >0 NUMBER OF BLOCKS IN THE FILE (NORMAL RETURN FOR 'OL') C =0 NORMAL RETURN FOR 'NE' C -1 NO RT-11 CHANNELS ARE AVAILABLE C -2 ILLEGAL DEVICE SPECIFICATION IN FILENAME STRING C -3 ILLEGAL FILENAME C -4 DEVICE IN USE C -5 LOGICAL UNIT IN USE OR NO LU SPACE AVAILABLE C -6 LOOKUP ERROR C -7 ILLEGAL TYPE C -8 FILE NOT FOUND ON 'OLD' C -9 FILE ALREADY EXISTS ON 'NEW' C -10 DEVICE HANDLER DOES NOT EXIST C -11 NOT ENOUGH ROOM FOR HANDLER C -12 DEVICE DOES NOT EXIST C -13 DEVICE HARDWARE ERROR C C PROGRAMMER: ROBERT WALRAVEN, UCD VERSION 3.0 3 JUL 1980 C C---------------------------------------------------------------------- C C COMMON /IOFILE/ SPEC,OUT,DBLK,BUF,EXT INTEGER SPEC(39), OUT(6) ,TYPE, NAME(1), DBLK(4), BUF(65), DEVNAM REAL EXT(2) EQUIVALENCE (DEVNAM,SPEC(16)) DATA DATDAT/6RDATDAT/ C EXT(1) = DATDAT EXT(2) = DATDAT DO 10 I=1,4 10 DBLK(I) = 0 ICHAN = IGETC() !GET A FREE CHANNEL IF (ICHAN.LT.0) GO TO 1000 IF (NAME(1) .EQ. 0) GO TO 20 !BRANCH IF QUERY WANTED CALL IRAD50 (12, NAME, DEVNAM) !CONVERT NAME TO RAD50 GO TO 110 20 WRITE(5,100) !QUERY FOR FILENAME 100 FORMAT(1X'FILENAME'/) I = -ICSI(SPEC,EXT,,,0) IF (I.GT.0) GO TO 1010 110 I = IFETCH(DEVNAM) !FETCH THE HANDLER IF (I.NE.0) GO TO 1160 DBLK(1) = DEVNAM !GET DEVICE NAME I = LOOKUP (ICHAN,DBLK) !NON-FILE LOOKUP I = ISPFNW ("377, ICHAN, 0, BUF, 1) !TRY READING IF (I.EQ.2) GO TO 1230 CALL PURGE(ICHAN) I = LOOKUP(ICHAN,DEVNAM) !CHECK STATUS OF FILE IF (I.EQ.-3) GO TO 1020 !ERROR IF DEVICE IN USE IOFILE = I IF (TYPE .EQ. 'NE') GO TO 200 !'NEW' FILE? IF (TYPE .EQ. 'UN') GO TO 300 !'UNKNOWN' FILE? IF (TYPE .NE. 'OL') GO TO 1100 !ERROR IF NOT 'OLD' FILE IF (I .EQ. -2) GO TO 1120 !OLD FILE MUST EXIST IF (I .LT. 0) GO TO 1040 !AND LOOKUP BE O.K. ISIZE = 0 ICODE = 32 !READ ONLY GO TO 400 200 IF (I .GT. 0) GO TO 1140 !NEW FILE MUST NOT EXIST IF (I .EQ. 0) GO TO 300 !FILE-STRUCTURED DEVICE? IF (I .NE. -2) GO TO 1040 !LOOKUP MUST BE O.K. 300 ICODE = 1 !DOUBLE BUFFERED 400 I=IASIGN(LUN,DEVNAM,SPEC(17),ISIZE,ICODE) !ASSIGN THE FILE IF (I.NE.0) GO TO 1050 IF (IOFILE .LT. 0) IOFILE=0 GO TO 2000 C C--------------------ERRORS PROCESSED HERE----------------------------- C 1000 IOFILE = -1 GO TO 1060 1010 IOFILE = IERR-3 GO TO 1060 1020 IOFILE = -4 GO TO 1060 1040 IOFILE = -6 GO TO 1060 1050 IOFILE = -5 1060 WRITE (5,1070) IOFILE 1070 FORMAT(1X'IOFILE ERROR = 'I3) GO TO 2000 1100 WRITE (5,1110) 1110 FORMAT(1X'ILLEGAL TYPE') IOFILE = -7 GO TO 2000 1120 WRITE(5,1130) 1130 FORMAT(1X'FILE NOT FOUND') IOFILE = -8 GO TO 2000 1140 WRITE (5,1150) 1150 FORMAT(1X'FILE ALREADY EXISTS') IOFILE = -9 GO TO 2000 1160 IOFILE = I-13 GO TO (1170,1190,1210),I 1170 WRITE (5,1180) 1180 FORMAT(1X'DEVICE HANDLER DOES NOT EXIST') GO TO 2000 1190 WRITE (5,1200) 1200 FORMAT(1X'NOT ENOUGH ROOM FOR HANDLER') GO TO 2000 1210 WRITE (5,1220) 1220 FORMAT(1X'DEVICE DOES NOT EXIST') GO TO 2000 1230 WRITE (5,1240) 1240 FORMAT(1X'DEVICE HARDWARE ERROR') IOFILE = -13 C C--------------------PURGE CHANNEL AND RETURN-------------------------- C 2000 CALL PURGE (ICHAN) CALL IFREEC (ICHAN) RETURN END