[Info-vax] Fortran problem with QIO
Arne Vajhøj
arne at vajhoej.dk
Wed Dec 2 22:28:13 EST 2009
gerry77 at no.spam.mail.com wrote:
> On Wed, 2 Dec 2009 10:07:27 -0800 (PST), Hein RMS van den Heuvel
> <heinvandenheuvel at gmail.com> wrote:
>
>>> Call me crazy, but I'm trying to (re)learn Fortran while experimenting with
>>> 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
>> You are Crazy!
>> 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
More information about the Info-vax
mailing list