1000 OPTION TYPE = EXPLICIT, & SIZE = (INTEGER LONG, REAL DOUBLE), & SCALE = 0, & ACTIVE = (INTEGER OVERFLOW, SETUP, SUBSCRIPT CHECKING) RECORD QUAD LONG LO_LRec LONG HI_LRec END RECORD RECORD DVI BYTE COUNT_BRec STRING TEXT_SRec=15 END RECORD RECORD FILENAME STRING TEXT_SRec=255 END RECORD RECORD ACL STRING TEXT_SRec=512 END RECORD MAP (TRY) STRING BUF_MS=512 MAP (X) STRING DESCRIPTION_MS=256 MAP (X) STRING TMP_MS=30 EXTERNAL QUAD RSO_GQ_CREATION_DATE, & RSO_GQ_REVISION_DATE, & RSO_GQ_EXPIRATION_DATE, & RSO_GQ_BACKUP_DATE EXTERNAL LONG RSO_GL_FILESIZE, & RSO_GL_RSTS_MODE, & RSO_GL_RSTS_CLUSTER, & RSO_GL_RSTS_PROTECTION_CODE, & RSO_GL_RSTS_POSITION, & RSO_GL_UIC, & RSO_GL_NEXT_NEW_BLOCK, & RSO_GL_RMS_STS, & RSO_GL_RMS_STV, & RSO_GL_DEVCHR, & RSO_GL_DEVCHR2, & RSO_GL_FAB_FOP, & RSO_GL_RAB_ROP, & RSO_GA_RAB_ADDR, & RSO_GL_ACL_CONTEXT, & RSO_GL_ACL_STS EXTERNAL WORD RSO_GW_NODE_OFF, & RSO_GW_DEV_OFF, & RSO_GW_DIR_OFF, & RSO_GW_NAME_OFF, & RSO_GW_TYPE_OFF, & RSO_GW_VER_OFF, & RSO_GW_NODE_LEN, & RSO_GW_DEV_LEN, & RSO_GW_DIR_LEN, & RSO_GW_NAME_LEN, & RSO_GW_TYPE_LEN, & RSO_GW_VER_LEN, & RSO_GW_DID1, & RSO_GW_DID2, & RSO_GW_DID3, & RSO_GW_FID1, & RSO_GW_FID2, & RSO_GW_FID3, & RSO_GW_NEXT_NEW_BYTE, & RSO_GW_FILE_EXTENT, & RSO_GW_PROTECTION_CODE, & RSO_GW_VERSION_LIMIT, & RSO_GW_N.REVISIONS, & RSO_GW_BLOCK_SIZE, & RSO_GW_BUFFER_COUNT, & RSO_GW_MULTI_BLOCK, & RSO_GW_FAB_IFI, & RSO_GW_WINDOWSIZE, & RSO_GW_LEN, & RSO_GW_ACLLEN, & RSO_GW_RAB_ISI, & RSO_GW_GLOBAL_BUFFER EXTERNAL BYTE RSO_GB_CHAN_MODE, & RSO_GB_FILE_MODE, & RSO_GB_LNM_MODE, & RSO_GB_FAB_FAC, & RSO_GB_FAB_SHR, & RSO_GB_MTACC EXTERNAL DVI RSO_GT_DVI EXTERNAL FILENAME RSO_GT_FILENAME EXTERNAL ACL RSO_GT_ACL DECLARE LONG CONSTANT FALSE_LK = 0 DECLARE LONG CONSTANT TRUE_LK = NOT FALSE_LK DECLARE QUAD STATUS_QF, & LONG OPEN.STATUS_LF, & TMP9_L, & STATUS_LF, & ABORT_LF, & WORD ACL.OFFSET_W, & L.TMP_W, & L.ACL_W, & L.ACE_W, & L.DESCRIPTION_W, & STRING FILENAME_S, & REPLY_S, & TMP_S EXTERNAL QUAD FUNCTION RSO_CLOSE EXTERNAL LONG CONSTANT SS$_NORMAL EXTERNAL LONG CONSTANT DEV$M_ALL, ! Declare DEV bit masks & DEV$M_AVL, & DEV$M_CCL, & DEV$M_CDP, & DEV$M_CLU, & DEV$M_DET, & DEV$M_DIR, & DEV$M_DMT, & DEV$M_DUA, & DEV$M_ELG, & DEV$M_FOD, & DEV$M_FOR, & DEV$M_GEN, & DEV$M_IDV, & DEV$M_MBX, & DEV$M_MNT, & DEV$M_NET, & DEV$M_ODV, & DEV$M_OPR, & DEV$M_RCK, & DEV$M_RCT, & DEV$M_REC, & DEV$M_RND, & DEV$M_RTM, & DEV$M_RTT, & DEV$M_SDI, & DEV$M_SHR, & DEV$M_SPL, & DEV$M_SQD, & DEV$M_SWL, & DEV$M_TRM, & DEV$M_WCK EXTERNAL LONG CONSTANT FAB$M_CBT, ! Declare FAB's FAC bit masks & FAB$M_CIF, & FAB$M_CTG, & FAB$M_DFW, & FAB$M_DLT, & FAB$M_MXV, & FAB$M_NAM, & FAB$M_NEF, & FAB$M_NFS, & FAB$M_OFP, & FAB$M_POS, & FAB$M_RCK, & FAB$M_RWC, & FAB$M_RWO, & FAB$M_SCF, & FAB$M_SQO, & FAB$M_SPL, & FAB$M_SUP, & FAB$M_TEF, & FAB$M_TMD, & FAB$M_TMP, & FAB$M_UFO, & FAB$M_WCK EXTERNAL LONG CONSTANT RAB$M_ASY, ! Declare RAB's ROP bit masks & RAB$M_BIO, & RAB$M_CCO, & RAB$M_CVT, & RAB$M_EOF, & RAB$M_ETO, & RAB$M_FDL, & RAB$M_KGE, & RAB$M_KGT, & RAB$M_LIM, & RAB$M_LOA, & RAB$M_LOC, & RAB$M_NLK, & RAB$M_NXR, & RAB$M_PMT, & RAB$M_PTA, & RAB$M_RAH, & RAB$M_REA, & RAB$M_RLK, & RAB$M_RNE, & RAB$M_RNF, & RAB$M_RRL, & RAB$M_TMO, & RAB$M_TPT, & RAB$M_UIF, & RAB$M_ULK, & RAB$M_WAT, & RAB$M_WBH EXTERNAL BYTE CONSTANT FAB$M_BIO, ! Declare FAB's FAC bit masks & FAB$M_BRO, & FAB$M_DEL, & FAB$M_GET, & FAB$M_PUT, & FAB$M_TRN, & FAB$M_UPD EXTERNAL BYTE CONSTANT FAB$M_SHRDEL, ! Declare FAB's SHR bit masks & FAB$M_SHRGET, & FAB$M_MSE, & FAB$M_NIL, & FAB$M_SHRPUT, & FAB$M_SHRUPD, & FAB$M_UPI EXTERNAL LONG FUNCTION SYS$FORMAT_ACL DECLARE STRING FUNCTION UW.NUM_SFn(WORD), & VMSDATE_SFn (QUAD), & DEVCHR_SFn(LONG) 1100 ON ERROR GOTO 19000 PRINT CR+LF & +'OPEN for input, OPEN for output, OPENX--fake an open, CLOSE, RSO_CLOSE'+CR+LF & +' (I) (O) (X) (C) (R) '; LINPUT REPLY_S REPLY_S = EDIT$(REPLY_S, 1% + 2% + 4% + 32%) ! Remove parity/spaces_and_tabs/special_chars and capitalize SELECT REPLY_S CASE "I" ! OPEN FOR INPUT... GOSUB 2100 CASE "O" ! OPEN FOR OUTPUT... GOSUB 2200 CASE "X" ! Fake an OPEN, just scan filename GOSUB 2300 CASE "C" CLOSE #1% CASE "R" GOSUB 2800 CASE ELSE PRINT '?Please enter an "I", "O", "X", "C" or "R".' END SELECT GOTO 1100 2100 ! ! GOSUB -- OPEN for input using USEROPEN RSO_OPENI ! GOSUB 3000 ! Get filename GOTO 2190 IF ABORT_LF 2110 ON ERROR GOTO 2180 OPEN FILENAME_S FOR INPUT AS FILE #1%, & ORGANIZATION VIRTUAL, & MAP TRY, & USEROPEN RSO_OPENI 2120 GOSUB 12000 GOTO 2190 2180 PRINT 'Failure to OPEN FOR INPUT, CALL.FAILED_IF =';ERR PRINT ' FAB/RAB$L_STS: ';NUM1$(RSO_GL_RMS_STS) PRINT ' FAB/RAB$L_STV: ';NUM1$(RSO_GL_RMS_STV) RESUME 2190 2190 RETURN 2200 ! ! GOSUB -- OPEN for output using USEROPEN RSO_OPENO ! GOSUB 3000 ! Get filename GOTO 2290 IF ABORT_LF 2210 ON ERROR GOTO 2280 OPEN FILENAME_S FOR OUTPUT AS FILE #1%, & ORGANIZATION VIRTUAL, & MAP TRY, & USEROPEN RSO_OPENO 2220 GOSUB 12000 GOTO 2290 2280 PRINT 'Failure to OPEN FOR OUTPUT, CALL.FAILED_IF =';ERR PRINT ' FAB/RAB$L_STS: ';NUM1$(RSO_GL_RMS_STS) PRINT ' FAB/RAB$L_STV: ';NUM1$(RSO_GL_RMS_STV) RESUME 2290 2290 RETURN 2300 ! ! GOSUB -- Fake an OPEN using USEROPEN RSO_OPENX ! GOSUB 3000 ! Get filename GOTO 2390 IF ABORT_LF 2310 ON ERROR GOTO 2380 OPEN FILENAME_S AS FILE #1%, & ORGANIZATION VIRTUAL, & MAP TRY, & USEROPEN RSO_OPENX 2320 GOSUB 12000 GOTO 2390 2380 PRINT 'Failure on OPENX, CALL.FAILED_IF =';ERR PRINT ' FAB/RAB$L_STS: ';NUM1$(RSO_GL_RMS_STS) PRINT ' FAB/RAB$L_STV: ';NUM1$(RSO_GL_RMS_STV) RESUME 2390 2390 RETURN 2800 ! ! GOSUB -- RSO_CLOSE ! ON ERROR GOTO 2880 STATUS_QF = RSO_CLOSE( RSO_GW_FAB_IFI by ref, & RSO_GQ_REVISION_DATE by ref, & RSO_GW_N.REVISIONS by ref, & RSO_GL_UIC by ref, & RSO_GW_PROTECTION_CODE by ref) PRINT "Results of RSO_CLOSE: FAB$L_STS = ";NUM1$(STATUS_QF::LO_LRec); & ", FAB$L_STV = ";NUM1$(STATUS_QF::HI_LRec) 2810 ! Because the RSO_CLOSE doesn't inform BASIC of the fact that the ! channel is now closed, we have an awkward situation. Should ! this program exit normally, the exit handler BASIC declared ! for cleaning up what it thinks are still-OPENed channels will ! yield a fatal error message saying that BASIC has an invalid ! RMS internal file identifier (IFI). To get around this ! problem, we will use the channel again and service the inevi- ! table (but trappable) "?Fatal System I/O error". OPEN "X.DAT" FOR INPUT AS FILE #1% ! Execution should never get beyond this point. However, if ! it does, then we'll have to rethink how we are to solve the ! IFI dilema posed by RSO_CLOSE. PRINT "??TOTAL CONFUSION -- Refigure RSO_CLOSE solution" GOTO 32767 ! Technically, this is illegal inside a subroutine !...but we just want to get out of here FAST. 2880 ON ERROR GOTO 0 UNLESS ERR = 12% ! Trap unexpected errors RESUME 2890 2890 RETURN 3000 ! ! GOSUB -- Get filename (default to last name entered) ! ON ERROR GOTO 3080 ABORT_LF = FALSE_LK PRINT 'Name of file to OPEN '; PRINT '<';FILENAME_S;'> '; IF LEN(FILENAME_S) ! <> 0 implying default value possible LINPUT REPLY_S REPLY_S = EDIT$(REPLY_S, 1% + 2% + 4% + 32%) ! Remove parity/spaces_and_tabs/special_chars and capitalize REPLY_S = FILENAME_S IF LEN(REPLY_S) = 0% FILENAME_S = REPLY_S GOTO 3090 3080 ON ERROR GOTO 0 UNLESS ERR = 11% ! Trap any error which is not a result of ^Z input ABORT_LF = TRUE_LK RESUME 3090 3090 ON ERROR GOTO 19000 RETURN 12000 ! ! GOSUB -- print statistics on file just OPENed ! OPEN.STATUS_LF = STATUS PRINT ' File opened: "';LEFT$(RSO_GT_FILENAME::TEXT_SRec, RSO_GW_LEN);'"' PRINT PRINT ' Node: "';MID$(RSO_GT_FILENAME::TEXT_SRec, RSO_GW_NODE_OFF + 1%, RSO_GW_NODE_LEN);'"' PRINT ' Device: "';MID$(RSO_GT_FILENAME::TEXT_SRec, RSO_GW_DEV_OFF + 1%, RSO_GW_DEV_LEN); '"' PRINT ' Directory: "';MID$(RSO_GT_FILENAME::TEXT_SRec, RSO_GW_DIR_OFF + 1%, RSO_GW_DIR_LEN); '"' PRINT ' Filename: "';MID$(RSO_GT_FILENAME::TEXT_SRec, RSO_GW_NAME_OFF + 1%, RSO_GW_NAME_LEN);'"' PRINT ' Type: "';MID$(RSO_GT_FILENAME::TEXT_SRec, RSO_GW_TYPE_OFF + 1%, RSO_GW_TYPE_LEN);'"' PRINT ' Version: "';MID$(RSO_GT_FILENAME::TEXT_SRec, RSO_GW_VER_OFF + 1%, RSO_GW_VER_LEN); '"' PRINT ' /FILESIZE: ';NUM1$(RSO_GL_FILESIZE) IF RSO_GL_FILESIZE PRINT ' /MODE: ';NUM1$(RSO_GL_RSTS_MODE) IF RSO_GL_RSTS_MODE PRINT ' /CLUSTER: ';NUM1$(RSO_GL_RSTS_CLUSTER) IF RSO_GL_RSTS_CLUSTER PRINT ' : ';NUM1$(RSO_GL_RSTS_PROTECTION_CODE) IF RSO_GL_RSTS_PROTECTION_CODE PRINT ' /POSITION: ';NUM1$(RSO_GL_RSTS_POSITION) IF RSO_GL_RSTS_POSITION PRINT ' /DVI= "';LEFT$(RSO_GT_DVI::TEXT_SRec, RSO_GT_DVI::COUNT_BRec);'"' & IF RSO_GT_DVI::COUNT_BRec ! <> 0% implying DVI to return PRINT ' /DID= (';UW.NUM_SFn(RSO_GW_DID1);',' & ;UW.NUM_SFn(RSO_GW_DID2);',' & ;UW.NUM_SFn(RSO_GW_DID3);')' & IF (RSO_GW_DID1 OR RSO_GW_DID2 OR RSO_GW_DID3) ! <> 0% implying DID to return PRINT ' /FID= (';UW.NUM_SFn(RSO_GW_FID1);',' & ;UW.NUM_SFn(RSO_GW_FID2);',' & ;UW.NUM_SFn(RSO_GW_FID3);')' & IF (RSO_GW_FID1 OR RSO_GW_FID2 OR RSO_GW_FID3) ! <> 0% implying FID to return PRINT ' /CREATION= ';VMSDATE_SFn(RSO_GQ_CREATION_DATE) & IF RSO_GQ_CREATION_DATE::LO_LRec <> 0% AND RSO_GQ_CREATION_DATE::HI_LRec <> 0% PRINT ' /REVISION= ';VMSDATE_SFn(RSO_GQ_REVISION_DATE) & IF RSO_GQ_REVISION_DATE::LO_LRec <> 0% AND RSO_GQ_REVISION_DATE::HI_LRec <> 0% PRINT ' /EXPIRATION= ';VMSDATE_SFn(RSO_GQ_EXPIRATION_DATE) & IF RSO_GQ_EXPIRATION_DATE::LO_LRec <> 0% AND RSO_GQ_EXPIRATION_DATE::HI_LRec <> 0% PRINT ' /BACKUP= ';VMSDATE_SFn(RSO_GQ_BACKUP_DATE) & IF RSO_GQ_BACKUP_DATE::LO_LRec <> 0% AND RSO_GQ_BACKUP_DATE::HI_LRec <> 0% PRINT ' UIC= [';NUM1$((X"FFFF0000"L AND RSO_GL_UIC)/X"10000"L); & ',';NUM1$(X"FFFF"L AND RSO_GL_UIC);']' IF RSO_GL_UIC PRINT 'next new block: ';NUM1$(RSO_GL_NEXT_NEW_BLOCK) IF RSO_GL_NEXT_NEW_BLOCK PRINT ' next new byte: ';NUM1$(RSO_GW_NEXT_NEW_BYTE) & IF RSO_GL_NEXT_NEW_BLOCK <> 0% AND RSO_GW_NEXT_NEW_BYTE <> 0% PRINT ' /EXTENT= ';NUM1$(RSO_GW_FILE_EXTENT) IF RSO_GW_FILE_EXTENT IF RSO_GW_PROTECTION_CODE THEN PRINT ' /PROTECTION= (SYSTEM'; PRINT ':'; IF X"000F"W AND RSO_GW_PROTECTION_CODE PRINT 'R'; IF X"0001"W AND RSO_GW_PROTECTION_CODE PRINT 'W'; IF X"0002"W AND RSO_GW_PROTECTION_CODE PRINT 'E'; IF X"0004"W AND RSO_GW_PROTECTION_CODE PRINT 'D'; IF X"0008"W AND RSO_GW_PROTECTION_CODE PRINT ',OWNER'; PRINT ':'; IF X"00F0"W AND RSO_GW_PROTECTION_CODE PRINT 'R'; IF X"0010"W AND RSO_GW_PROTECTION_CODE PRINT 'W'; IF X"0020"W AND RSO_GW_PROTECTION_CODE PRINT 'E'; IF X"0040"W AND RSO_GW_PROTECTION_CODE PRINT 'D'; IF X"0080"W AND RSO_GW_PROTECTION_CODE PRINT ',GROUP'; PRINT ':'; IF X"0F00"W AND RSO_GW_PROTECTION_CODE PRINT 'R'; IF X"0100"W AND RSO_GW_PROTECTION_CODE PRINT 'W'; IF X"0200"W AND RSO_GW_PROTECTION_CODE PRINT 'E'; IF X"0400"W AND RSO_GW_PROTECTION_CODE PRINT 'D'; IF X"0800"W AND RSO_GW_PROTECTION_CODE PRINT ',WORLD'; PRINT ':'; IF X"F000"W AND RSO_GW_PROTECTION_CODE PRINT 'R'; IF X"1000"W AND RSO_GW_PROTECTION_CODE PRINT 'W'; IF X"2000"W AND RSO_GW_PROTECTION_CODE PRINT 'E'; IF X"4000"W AND RSO_GW_PROTECTION_CODE PRINT 'D'; IF X"8000"W AND RSO_GW_PROTECTION_CODE PRINT ')' END IF PRINT '/VERSION_LIMIT= ';NUM1$(RSO_GW_VERSION_LIMIT) IF RSO_GW_VERSION_LIMIT PRINT ' /N_REVISIONS= ';NUM1$(RSO_GW_N.REVISIONS) IF RSO_GW_N.REVISIONS PRINT ' /BUFFER_COUNT= ';NUM1$(RSO_GW_BUFFER_COUNT) IF RSO_GW_BUFFER_COUNT PRINT ' /MULTI_BLOCK= ';NUM1$(RSO_GW_MULTI_BLOCK) IF RSO_GW_MULTI_BLOCK PRINT ' FAB$W_IFI: ';UW.NUM_SFn(RSO_GW_FAB_IFI) PRINT ' FAB/RAB$L_STS: ';NUM1$(RSO_GL_RMS_STS) PRINT ' FAB/RAB$L_STV: ';NUM1$(RSO_GL_RMS_STV) PRINT ' RAB$W_ISI: ';NUM1$(RSO_GW_RAB_ISI) PRINT '/GLOBAL_BUFFER= ';NUM1$(RSO_GW_GLOBAL_BUFFER) IF RSO_GW_GLOBAL_BUFFER PRINT ' /BLOCK_SIZE= ';NUM1$(RSO_GW_BLOCK_SIZE) IF RSO_GW_BLOCK_SIZE PRINT ' /WINDOWSIZE= ';NUM1$(RSO_GW_WINDOWSIZE) IF RSO_GW_WINDOWSIZE PRINT ' Dev character: (';NUM1$(RSO_GL_DEVCHR);') ';DEVCHR_SFn(RSO_GL_DEVCHR) IF RSO_GL_DEVCHR PRINT 'Dev character2: (';NUM1$(RSO_GL_DEVCHR2);') ';DEVCHR_SFn(RSO_GL_DEVCHR2) IF RSO_GL_DEVCHR2 PRINT ' /CHAN_MODE= ';NUM1$(RSO_GB_CHAN_MODE) IF RSO_GB_CHAN_MODE PRINT ' /FILE_MODE= ';NUM1$(RSO_GB_FILE_MODE) IF RSO_GB_FILE_MODE PRINT ' /LNM_MODE= ';NUM1$(RSO_GB_LNM_MODE) IF RSO_GB_LNM_MODE PRINT ' /MTACC= ';NUM1$(RSO_GB_MTACC) IF RSO_GB_MTACC IF RSO_GB_FAB_FAC ! <> 0 implying File ACcess (FAC) in File Access Block (FAB) THEN PRINT "FAB's FAC bits: (";NUM1$(RSO_GB_FAB_FAC);') '; PRINT 'BIO '; IF (RSO_GB_FAB_FAC AND FAB$M_BIO) PRINT 'BRO '; IF (RSO_GB_FAB_FAC AND FAB$M_BRO) PRINT 'DEL '; IF (RSO_GB_FAB_FAC AND FAB$M_DEL) PRINT 'GET '; IF (RSO_GB_FAB_FAC AND FAB$M_GET) PRINT 'PUT '; IF (RSO_GB_FAB_FAC AND FAB$M_PUT) PRINT 'TRN '; IF (RSO_GB_FAB_FAC AND FAB$M_TRN) PRINT 'UPD '; IF (RSO_GB_FAB_FAC AND FAB$M_UPD) PRINT END IF IF RSO_GB_FAB_SHR ! <> 0 implying SHaRing access (SHR) in File Access Block (FAB) THEN PRINT "FAB's SHR bits: (";NUM1$(RSO_GB_FAB_SHR);') '; PRINT 'DEL '; IF (RSO_GB_FAB_SHR AND FAB$M_SHRDEL) PRINT 'GET '; IF (RSO_GB_FAB_SHR AND FAB$M_SHRGET) PRINT 'MSE '; IF (RSO_GB_FAB_SHR AND FAB$M_MSE) PRINT 'NIL '; IF (RSO_GB_FAB_SHR AND FAB$M_NIL) PRINT 'PUT '; IF (RSO_GB_FAB_SHR AND FAB$M_SHRPUT) PRINT 'UPD '; IF (RSO_GB_FAB_SHR AND FAB$M_SHRUPD) PRINT 'UPI '; IF (RSO_GB_FAB_SHR AND FAB$M_UPI) PRINT END IF IF RSO_GL_FAB_FOP ! <> 0 implying File OPtions (FOP) in File Access Block (FAB) THEN PRINT "FAB's FOP bits: (";NUM1$(RSO_GL_FAB_FOP);') '; PRINT 'CBT '; IF (RSO_GL_FAB_FOP AND FAB$M_CBT) PRINT 'CIF '; IF (RSO_GL_FAB_FOP AND FAB$M_CIF) PRINT 'CTG '; IF (RSO_GL_FAB_FOP AND FAB$M_CTG) PRINT 'DFW '; IF (RSO_GL_FAB_FOP AND FAB$M_DFW) PRINT 'DLT '; IF (RSO_GL_FAB_FOP AND FAB$M_DLT) PRINT 'MXV '; IF (RSO_GL_FAB_FOP AND FAB$M_MXV) PRINT 'NAM '; IF (RSO_GL_FAB_FOP AND FAB$M_NAM) PRINT 'NEF '; IF (RSO_GL_FAB_FOP AND FAB$M_NEF) PRINT 'NFS '; IF (RSO_GL_FAB_FOP AND FAB$M_NFS) PRINT 'OFP '; IF (RSO_GL_FAB_FOP AND FAB$M_OFP) PRINT 'POS '; IF (RSO_GL_FAB_FOP AND FAB$M_POS) PRINT 'RCK '; IF (RSO_GL_FAB_FOP AND FAB$M_RCK) PRINT 'RWC '; IF (RSO_GL_FAB_FOP AND FAB$M_RWC) PRINT 'RWO '; IF (RSO_GL_FAB_FOP AND FAB$M_RWO) PRINT 'SCF '; IF (RSO_GL_FAB_FOP AND FAB$M_SCF) PRINT 'SQO '; IF (RSO_GL_FAB_FOP AND FAB$M_SQO) PRINT 'SPL '; IF (RSO_GL_FAB_FOP AND FAB$M_SPL) PRINT 'SUP '; IF (RSO_GL_FAB_FOP AND FAB$M_SUP) PRINT 'TEF '; IF (RSO_GL_FAB_FOP AND FAB$M_TEF) PRINT 'TMD '; IF (RSO_GL_FAB_FOP AND FAB$M_TMD) PRINT 'TMP '; IF (RSO_GL_FAB_FOP AND FAB$M_TMP) PRINT 'UFO '; IF (RSO_GL_FAB_FOP AND FAB$M_UFO) PRINT 'WCK '; IF (RSO_GL_FAB_FOP AND FAB$M_WCK) PRINT END IF IF RSO_GL_RAB_ROP ! <> 0 implying Record OPtions (ROP) in Record Access Block (RAB) THEN PRINT "RAB's ROP bits: (";NUM1$(RSO_GL_RAB_ROP);') '; PRINT 'ASY '; IF (RSO_GL_RAB_ROP AND RAB$M_ASY) PRINT 'BIO '; IF (RSO_GL_RAB_ROP AND RAB$M_BIO) PRINT 'CCO '; IF (RSO_GL_RAB_ROP AND RAB$M_CCO) PRINT 'CVT '; IF (RSO_GL_RAB_ROP AND RAB$M_CVT) PRINT 'EOF '; IF (RSO_GL_RAB_ROP AND RAB$M_EOF) PRINT 'ETO '; IF (RSO_GL_RAB_ROP AND RAB$M_ETO) PRINT 'FDL '; IF (RSO_GL_RAB_ROP AND RAB$M_FDL) PRINT 'KGE '; IF (RSO_GL_RAB_ROP AND RAB$M_KGE) PRINT 'KGT '; IF (RSO_GL_RAB_ROP AND RAB$M_KGT) PRINT 'LIM '; IF (RSO_GL_RAB_ROP AND RAB$M_LIM) PRINT 'LOA '; IF (RSO_GL_RAB_ROP AND RAB$M_LOA) PRINT 'LOC '; IF (RSO_GL_RAB_ROP AND RAB$M_LOC) PRINT 'NLK '; IF (RSO_GL_RAB_ROP AND RAB$M_NLK) PRINT 'NXR '; IF (RSO_GL_RAB_ROP AND RAB$M_NXR) PRINT 'PMT '; IF (RSO_GL_RAB_ROP AND RAB$M_PMT) PRINT 'PTA '; IF (RSO_GL_RAB_ROP AND RAB$M_PTA) PRINT 'RAH '; IF (RSO_GL_RAB_ROP AND RAB$M_RAH) PRINT 'REA '; IF (RSO_GL_RAB_ROP AND RAB$M_REA) PRINT 'RLK '; IF (RSO_GL_RAB_ROP AND RAB$M_RLK) PRINT 'RNE '; IF (RSO_GL_RAB_ROP AND RAB$M_RNE) PRINT 'RNF '; IF (RSO_GL_RAB_ROP AND RAB$M_RNF) PRINT 'RRL '; IF (RSO_GL_RAB_ROP AND RAB$M_RRL) PRINT 'TMO '; IF (RSO_GL_RAB_ROP AND RAB$M_TMO) PRINT 'TPT '; IF (RSO_GL_RAB_ROP AND RAB$M_TPT) PRINT 'UIF '; IF (RSO_GL_RAB_ROP AND RAB$M_UIF) PRINT 'ULK '; IF (RSO_GL_RAB_ROP AND RAB$M_ULK) PRINT 'WAT '; IF (RSO_GL_RAB_ROP AND RAB$M_WAT) PRINT 'WBH '; IF (RSO_GL_RAB_ROP AND RAB$M_WBH) PRINT END IF PRINT " RAB's addr: ";NUM1$(RSO_GA_RAB_ADDR) IF OPEN.STATUS_LF ! <> 0 THEN PRINT " STATUS: (";NUM1$(OPEN.STATUS_LF);') '; PRINT 'Rec_oriented '; IF (OPEN.STATUS_LF AND "1"L) PRINT 'Carriage '; IF (OPEN.STATUS_LF AND "2"L) PRINT 'Terminal '; IF (OPEN.STATUS_LF AND "4"L) PRINT 'Dir_dev '; IF (OPEN.STATUS_LF AND "8"L) PRINT 'Single_dir '; IF (OPEN.STATUS_LF AND "16"L) PRINT 'Seq_blk_oriented '; IF (OPEN.STATUS_LF AND "32"L) PRINT END IF PRINT " total ACL len: ";NUM1$(RSO_GW_ACLLEN) IF RSO_GW_ACLLEN PRINT " ACL context: ";;NUM1$(RSO_GL_ACL_CONTEXT) IF RSO_GL_ACL_CONTEXT PRINT " ACL status: ";NUM1$(RSO_GL_ACL_STS) IF RSO_GL_ACL_STS IF RSO_GW_ACLLEN > 512. THEN L.ACL_W = 512. ELSE L.ACL_W = RSO_GW_ACLLEN END IF ACL.OFFSET_W = "1"W ACE_loop: WHILE ACL.OFFSET_W =< L.ACL_W L.ACE_W = ASCII(MID$(RSO_GT_ACL::TEXT_SRec, ACL.OFFSET_W, 1%)) EXIT ACE_loop IF L.ACE_W = "0"W STATUS_LF = SYS$FORMAT_ACL(MID$(RSO_GT_ACL::TEXT_SRec, ACL.OFFSET_W, L.ACE_W) by desc & ,L.DESCRIPTION_W by ref & ,DESCRIPTION_MS by desc & ,"60"L by ref & ,CR+LF+" " by desc, , ) IF STATUS_LF = SS$_NORMAL THEN PRINT " ACE = ";LEFT$(DESCRIPTION_MS, L.DESCRIPTION_W) ELSE PRINT "%RSOTEST-F-ERROR, SYS$FORMAT_ACL failure, status =";STATUS_LF EXIT ACE_loop END IF ACL.OFFSET_W = ACL.OFFSET_W + L.ACE_W NEXT RETURN 15000 DEF STRING VMSDATE_SFn(QUAD DATE_PQ) EXTERNAL LONG FUNCTION SYS$ASCTIM STATUS_LF = SYS$ASCTIM(L.TMP_W by ref, TMP_MS by desc, DATE_PQ by ref, "0"L by ref) IF STATUS_LF <> SS$_NORMAL THEN VMSDATE_SFn = "** BAD DATE/TIME **" ELSE VMSDATE_SFn = LEFT$(TMP_MS, L.TMP_W) END IF END DEF DEF STRING UW.NUM_SFn(WORD X_PUW) TMP9_L = X_PUW UW.NUM_SFn = NUM1$(X"FFFF"L AND TMP9_L) END DEF 15100 DEF STRING DEVCHR_SFn(LONG DEVMASK_PL) TMP_S = '' TMP_S = TMP_S + 'ALL ' IF (DEVMASK_PL AND DEV$M_ALL) TMP_S = TMP_S + 'AVL ' IF (DEVMASK_PL AND DEV$M_AVL) TMP_S = TMP_S + 'CCL ' IF (DEVMASK_PL AND DEV$M_CCL) TMP_S = TMP_S + 'CDP ' IF (DEVMASK_PL AND DEV$M_CDP) TMP_S = TMP_S + 'CLU ' IF (DEVMASK_PL AND DEV$M_CLU) TMP_S = TMP_S + 'DET ' IF (DEVMASK_PL AND DEV$M_DET) TMP_S = TMP_S + 'DIR ' IF (DEVMASK_PL AND DEV$M_DIR) TMP_S = TMP_S + 'DMT ' IF (DEVMASK_PL AND DEV$M_DMT) TMP_S = TMP_S + 'DUA ' IF (DEVMASK_PL AND DEV$M_DUA) TMP_S = TMP_S + 'ELG ' IF (DEVMASK_PL AND DEV$M_ELG) TMP_S = TMP_S + 'FOD ' IF (DEVMASK_PL AND DEV$M_FOD) TMP_S = TMP_S + 'FOR ' IF (DEVMASK_PL AND DEV$M_FOR) TMP_S = TMP_S + 'GEN ' IF (DEVMASK_PL AND DEV$M_GEN) TMP_S = TMP_S + 'IDV ' IF (DEVMASK_PL AND DEV$M_IDV) TMP_S = TMP_S + 'MBX ' IF (DEVMASK_PL AND DEV$M_MBX) TMP_S = TMP_S + 'MNT ' IF (DEVMASK_PL AND DEV$M_MNT) TMP_S = TMP_S + 'NET ' IF (DEVMASK_PL AND DEV$M_NET) TMP_S = TMP_S + 'ODV ' IF (DEVMASK_PL AND DEV$M_ODV) TMP_S = TMP_S + 'OPR ' IF (DEVMASK_PL AND DEV$M_OPR) TMP_S = TMP_S + 'RCK ' IF (DEVMASK_PL AND DEV$M_RCK) TMP_S = TMP_S + 'RCT ' IF (DEVMASK_PL AND DEV$M_RCT) TMP_S = TMP_S + 'REC ' IF (DEVMASK_PL AND DEV$M_REC) TMP_S = TMP_S + 'RND ' IF (DEVMASK_PL AND DEV$M_RND) TMP_S = TMP_S + 'RTM ' IF (DEVMASK_PL AND DEV$M_RTM) TMP_S = TMP_S + 'RTT ' IF (DEVMASK_PL AND DEV$M_RTT) TMP_S = TMP_S + 'SDI ' IF (DEVMASK_PL AND DEV$M_SDI) TMP_S = TMP_S + 'SHR ' IF (DEVMASK_PL AND DEV$M_SHR) TMP_S = TMP_S + 'SPL ' IF (DEVMASK_PL AND DEV$M_SPL) TMP_S = TMP_S + 'SQD ' IF (DEVMASK_PL AND DEV$M_SQD) TMP_S = TMP_S + 'SWL ' IF (DEVMASK_PL AND DEV$M_SWL) TMP_S = TMP_S + 'TRM ' IF (DEVMASK_PL AND DEV$M_TRM) TMP_S = TMP_S + 'WCK ' IF (DEVMASK_PL AND DEV$M_WCK) DEVCHR_SFn = TMP_S TMP_S = '' END DEF 19000 ON ERROR GOTO 0 UNLESS ERR = 11% ! Trap for any non-^Z errors CLOSE #1% RESUME 32767 32767 END