Re: Fortran problem with QIO
- From: Arne Vajhøj <arne@xxxxxxxxxx>
- Date: Wed, 02 Dec 2009 22:28:13 -0500
gerry77@xxxxxxxxxxxxxxxx wrote:
On Wed, 2 Dec 2009 10:07:27 -0800 (PST), Hein RMS van den Heuvel
<heinvandenheuvel@xxxxxxxxx> wrote:
Call me crazy, but I'm trying to (re)learn Fortran while experimenting withYou are Crazy!
some system services, and I have chosen the steepest approach to the matter:
I'm trying to create a file with $QIOW in Fortran 77 on a VAX. :-P
Nobody does that.
Well, I'm crazy, so I DO that! :->
After posting my message here, and also following the good suggestion about
looking into the Unzip sources, I understood that my problem was due to some
bad descriptors. I've managed to create them right, and now the program
works! :-) It's just a proof of concept (I want to stress it again), and as
a matter of facts there are also some hard-coded values (e.g. the DID), but
it does what it's expected do to. It was a very instructive experience...
Here it is, comments are welcome:
PROGRAM IOTEST
IMPLICIT NONE
INCLUDE '($SYSSRVNAM)'
INCLUDE '($EFNDEF)'
INCLUDE '($FIBDEF)'
INCLUDE '($ATRDEF)'
INCLUDE '($DSCDEF)'
INCLUDE '($IODEF)'
INCLUDE '($SSDEF)'
STRUCTURE /FATDEF/ ! As per FATDEF in LIB.REQ et al.
PARAMETER FAT$K_LENGTH = '00000020'X
PARAMETER FAT$C_LENGTH = '00000020'X
PARAMETER FAT$S_FATDEF = '00000020'X
UNION
MAP
BYTE FAT$B_RTYPE
END MAP
MAP
PARAMETER FAT$C_UNDEFINED = '00000000'X
PARAMETER FAT$C_FIXED = '00000001'X
PARAMETER FAT$C_VARIABLE = '00000002'X
PARAMETER FAT$C_VFC = '00000003'X
PARAMETER FAT$C_STREAM = '00000004'X
PARAMETER FAT$C_STREAMLF = '00000005'X
PARAMETER FAT$C_STREAMCR = '00000006'X
BYTE FAT$V_RTYPE
END MAP
MAP
PARAMETER FAT$C_SEQUENTIAL = '00000000'X
PARAMETER FAT$C_RELATIVE = '00000008'X
PARAMETER FAT$C_INDEXED = '00000010'X
PARAMETER FAT$C_DIRECT = '0000001F'X
BYTE FAT$V_FILEORG
END MAP
END UNION
PARAMETER FAT$C_FORTRANCC = '00000001'X
PARAMETER FAT$C_IMPLIEDCC = '00000002'X
PARAMETER FAT$C_PRINTCC = '00000004'X
PARAMETER FAT$C_NOSPAN = '00000008'X
PARAMETER FAT$C_MSBRCW = '00000010'X
BYTE FAT$B_RATTRIB
INTEGER*2 FAT$W_RSIZE
UNION
MAP
INTEGER*4 FAT$L_HIBLK
END MAP
MAP
INTEGER*2 FAT$W_HIBLKH
INTEGER*2 FAT$W_HIBLKL
END MAP
END UNION
UNION
MAP
INTEGER*4 FAT$L_EFBLK
END MAP
MAP
INTEGER*2 FAT$W_EFBLKH
INTEGER*2 FAT$W_EFBLKL
END MAP
END UNION
INTEGER*2 FAT$W_FFBYTE
BYTE FAT$B_BKTSIZE
BYTE FAT$B_VFCSIZE
INTEGER*2 FAT$W_MAXREC
INTEGER*2 FAT$W_DEFEXT
INTEGER*2 FAT$W_GBC
BYTE %FILL(8)
INTEGER*2 FAT$W_VERSIONS
END STRUCTURE
STRUCTURE /IOSBDEF/ ! Official definition somewhere?
INTEGER*2 IOSB_W_STATUS
INTEGER*2 IOSB_W_BYTECOUNT
INTEGER*4 IOSB_L_BLKCOUNT END STRUCTURE
STRUCTURE /ATRDSC/ ! Made up of two different pieces:
UNION !
MAP !
RECORD /DSCDEF1/ DSC1 ! 1. Sort of generic header
END MAP !
MAP !
RECORD /DSCDEF5/ DSC5 ! 2. Specific body for array descriptors
END MAP
END UNION
END STRUCTURE
RECORD /ATRDEF/ ATR(4)
RECORD /FIBDEF/ FIB
RECORD /FATDEF/ FAT
RECORD /IOSBDEF/ IOSB
RECORD /DSCDEF1/ FIBDSC ! String/generic descriptor
RECORD /ATRDSC/ ATRDSC ! Array descriptor
INTEGER*4 + SS_STATUS,
+ CHAN,
+ FUNC
INTEGER*2
+ UIC(2),
+ FPRO ! File protection bitmask
CHARACTER
+ DEVNAM*9 /'SYS$DISK:'/,
+ FILNAM*10 /'MYFILE.DAT'/
FIB.FIB$W_DID_NUM = 146 ! Actual DID of my work directory
FIB.FIB$W_DID_SEQ = 34 !
FIB.FIB$W_DID_RVN = 0 !
FIB.FIB$L_ACCTL = FIB$M_WRITETHRU
FIB.FIB$W_NMCTL = FIB$M_NEWVER
FIB.FIB$W_EXCTL = FIB$M_EXTEND + FIB$M_ALDEF
FIB.FIB$L_EXSZ = 3
FIB.FIB$L_EXVBN = 0
FAT.FAT$B_RTYPE = FAT$C_FIXED + FAT$C_SEQUENTIAL
FAT.FAT$W_RSIZE = 30
FAT.FAT$W_MAXREC = 30
FAT.FAT$W_EFBLKH = 0
FAT.FAT$W_EFBLKL = 1
FAT.FAT$W_FFBYTE = 0
UIC(1) = '201'O ! My actual UIC in octal and reversed
UIC(2) = '200'O !
FPRO = '1100110011001100'B ! RW for everyone (S,O,G,W)
ATR(1).ATR$W_SIZE = ATR$S_RECATTR
ATR(1).ATR$W_TYPE = ATR$C_RECATTR
ATR(1).ATR$L_ADDR = LOC(FAT)
ATR(2).ATR$W_SIZE = ATR$S_UIC
ATR(2).ATR$W_TYPE = ATR$C_UIC
ATR(2).ATR$L_ADDR = LOC(UIC)
ATR(3).ATR$W_SIZE = ATR$S_FPRO
ATR(3).ATR$W_TYPE = ATR$C_FPRO
ATR(3).ATR$L_ADDR = LOC(FPRO)
ATR(4).ATR$W_SIZE = 0 ! Values to signal list-end
ATR(4).ATR$W_TYPE = 0 !
FIBDSC.DSC$W_MAXSTRLEN = FIB$K_LENGTH
FIBDSC.DSC$B_DTYPE = DSC$K_DTYPE_T
FIBDSC.DSC$B_CLASS = DSC$K_CLASS_S
FIBDSC.DSC$A_POINTER = LOC(FIB)
ATRDSC.DSC1.DSC$W_MAXSTRLEN = SIZEOF(ATR)
ATRDSC.DSC1.DSC$B_DTYPE = DSC$K_DTYPE_T
ATRDSC.DSC1.DSC$B_CLASS = DSC$K_CLASS_A ! Array type descriptor
ATRDSC.DSC1.DSC$A_POINTER = LOC(ATR) ATRDSC.DSC5.DSC$B_SCALE = 0 ! Are all this things
ATRDSC.DSC5.DSC$B_DIGITS = 0 ! really needed?
ATRDSC.DSC5.DSC$B_AFLAGS = 0 !
ATRDSC.DSC5.DSC$B_DIMCT = 1 !
ATRDSC.DSC5.DSC$L_ARSIZE = SIZEOF(ATR) !
ATRDSC.DSC5.DSC$A_A0 = LOC(ATR) !
You are not using ATRDSC !?!?
FUNC = IO$_CREATE + IO$M_CREATE
SS_STATUS = SYS$ASSIGN(%DESCR(DEVNAM),CHAN,,,)
SS_STATUS = SYS$QIOW(EFN$C_ENF, ! Efn (no EF used)
I would try %VAL on that!
+ %VAL(CHAN), ! Chan
+ %VAL(FUNC), ! Func
+ %REF(IOSB), ! Iosb
+ , ! ASTadr
+ , ! ASTprm
+ %REF(FIBDSC), ! P1 (FIB)
+ %DESCR(FILNAM), ! P2 (file name)
+ , ! P3
+ , ! P4
+ %REF(ATR), ! P5 (file attr.)
+ ) ! P6
SS_STATUS = SYS$DASSGN(%VAL(CHAN))
END
Arne
.
- Follow-Ups:
- Re: Fortran problem with QIO
- From: gerry77
- Re: Fortran problem with QIO
- References:
- Fortran problem with QIO
- From: gerry77
- Re: Fortran problem with QIO
- From: Hein RMS van den Heuvel
- Re: Fortran problem with QIO
- From: gerry77
- Fortran problem with QIO
- Prev by Date: Re: Host-Based InfoServer error
- Next by Date: Re: Host-Based InfoServer error
- Previous by thread: Re: Fortran problem with QIO
- Next by thread: Re: Fortran problem with QIO
- Index(es):
Relevant Pages
|
