1*----------------------------------------------------------------------* 2* rc=AixOpn(Handle,FileName) * 3* * 4* A file is opened for read/write operations. If the file does not * 5* exist it is automatically created. * 6* * 7* Input: FileName - A character string specifying a complete path * 8* name or relative path name for the file. The * 9* name must be shorter than 128 characters. * 10* * 11* Output: Handle - When a file is sucessfully opened, a unique file * 12* id is supplied by the routine. This is used for * 13* specifying the file to other routines. * 14*----------------------------------------------------------------------* 15* History: * 16* 911021 - If return code is 13 when opening file, try to open it as a * 17* read only file. Per-Olof Widmark. * 18* 931217 - Flags obtained from system calls. * 19* 010710 - Change using iRand to incremental number * 20* * 21************************************************************************ 22 Integer Function AixOpn(handle,name,translate) 23 Include 'ioparm.inc' 24 Include 'switch.inc' 25 Include 'ctl.inc' 26 Character*(*) name 27 Character*256 tmp 28 Logical Translate 29c Integer Length,Prog_Length 30 Integer StrnLn 31 External StrnLn 32 Character*256 tmp1 33 Character*80 ErrTxt 34 External Get_Progname 35 Character*100 Get_Progname 36 save NVV 37 data NVV /666/ 38 NTEST = 0 39*----------------------------------------------------------------------* 40* Entry to AixOpn * 41*----------------------------------------------------------------------* 42 AixOpn=0 43*----------------------------------------------------------------------* 44* Check if slot in table is available * 45*----------------------------------------------------------------------* 46 n=1 47100 If(CtlBlk(pStat,n).ne.vNaF) Then 48 n=n+1 49 If(n.gt.MxFile) Then 50 AixOpn=eTmF 51* Call SysWarnMsg('Aixopn','Too many opened files\n', 52* * 'try to increase MxFile') 53 STOP 'Aixopn: Too many opened files. Try to increase MxFile' 54 Return 55 End If 56 Go To 100 57 End If 58 nFile=n 59*----------------------------------------------------------------------* 60* Strip file name and append string terminator * 61*----------------------------------------------------------------------* 62 n=Len(name) 63200 If(name(n:n).eq.' ') Then 64 n=n-1 65 If(n.le.0) Then 66 AixOpn=eBlNme 67 Return 68 End If 69 Go To 200 70 End If 71 n=n+1 72 If(n.ge.Len(tmp)) Then 73 AixOpn=eTlFn 74 Return 75 End If 76 tmp=name 77 tmp(n:n)=Char(0) 78*----------------------------------------------------------------------* 79* Attempt to open file. * 80*----------------------------------------------------------------------* 81 rc = 0 82 tmp1=tmp 83 ltmp=StrnLn(tmp1) 84* if(translate) then 85cGLM call PrgmTranslate(tmp1,tmp,ltmp) 86* endif 87 tmp=tmp(1:ltmp) 88 tmp(ltmp+1:ltmp+1)=Char(0) 89 rc=c_open(tmp) 90 If(rc.lt.0) Then 91* rc=AixErr(ErrTxt) 92* Call SysWarnFileMsg('AixOpn',name, 93* * 'MSG: open',ErrTxt) 94 STOP 'MSG: open' 95* call SysPutsEnd() 96* Call Abend() 97 End If 98 desc=rc 99*----------------------------------------------------------------------* 100* Attempt sucessful, update control blocks. * 101*----------------------------------------------------------------------* 102c handle=iRand() 103 NVV=NVV+100 104 handle=NVV 105 CtlBlk(pHndle,nFile)=handle 106 CtlBlk(pDesc ,nFile)=desc 107 CtlBlk(pStat ,nFile)=vOpn 108 CtlBlk(pWhere,nFile)=vNull 109 FCtlBlk(nFile)=name 110 IF (NTEST.ge.10) then 111 write(6,*) ' *************************************************' 112 write(6,*) ' In AixOpn: ' 113 write(6,*) ' nFile: ', nFile 114 write(6,*) ' pHndle, CtlBlk(pHndle,nFile) : ', pHndle, handle 115 write(6,*) ' pDesc , CtlBlk(pDesc ,nFile) : ', pDesc, desc 116 write(6,*) ' pStat , CtlBlk(pStat ,nFile) : ', pStat, vOpn 117 write(6,*) ' pWhere, CtlBlk(pWhere,nFile) : ', pWhere, vNull 118 write(6,*) ' **************************************************' 119 End if 120*----------------------------------------------------------------------* 121* Finished so return to caller * 122*----------------------------------------------------------------------* 123 Return 124 End 125c $Id$ 126