Trailing-Edge
-
PDP-10 Archives
-
BB-R775C-BM
-
sources/dapper.b36
There are 24 other files named dapper.b36 in the archive. Click here to see a list.
%TITLE 'DAP Interface'
MODULE dapper (
IDENT='2.0(104)',
ENTRY (ROPEN, RREAD, RWRITE, RCLOSE, RDEL, RSUB, RRENM,
RDIRS, RDIR, RPRINT)
) =
BEGIN
! COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 1985.
! ALL RIGHTS RESERVED.
!
! THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND
! COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH
! THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR
! ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE
! AVAILABLE TO ANY OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE
! SOFTWARE IS HEREBY TRANSFERRED.
!
! THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
! NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
! EQUIPMENT CORPORATION.
!
! DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF
! ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!++
! FACILITY: DAP interface
!
! ABSTRACT:
! Provide system-independent remote file access by means
! of a library of user-callable routines on TOPS20, TOPS10, and
! VMS.
!
! ENVIRONMENT: User mode. Needs XPORT. Debug output uses TUTIO.
!
! AUTHOR: Charlotte L. Richardson
!
! CREATION DATE: 26 May 1982
!
! MODIFIED BY:
!
!--
%sbttl 'Require files';
!
! Require files:
!
! REQUIRE 'BLI:TUTIO';
REQUIRE 'RMSUSR.R36';
%sbttl 'Library files';
!
! Library files:
!
LIBRARY 'STAR36';
LIBRARY 'VERSION';
LIBRARY 'FIELDS';
%sbttl 'Edit History';
!
! Edit History:
!
MACRO
dit$k_version = DITVER %; ! [3] Produce 6-character name
new_version (1, 0)
edit (%o'1', '4-Oct-82', 'Charlotte L. Richardson')
%( Change version and revision standards. DAPPER.B36, DAPPER.B32, TTT.MAC,
TTT.BLI, RMSSTUFF.R32 )%
edit (%o'3', '14-Oct-82', 'Charlotte L. Richardson')
%( Produce a 6-character name on the 20 of DITVER for DIT$K_VERSION.
DAPPER.B36 )%
edit (%o'7', '29-Oct-82', 'Charlotte L. Richardson')
%( Check that character strings are only ASCII. TTT.MAC and DAPPER.B36 )%
edit (%o'25', '17-Nov-82', 'Charlotte L. Richardson')
%( DIT$_TOOMANYFIL in DAPPER.B36 should be DIT$_TOOMANY. DAPPER.B36 )%
edit (%o'33', '24-Nov-82', 'Charlotte L. Richardson')
%( Fix DAPPER.B36 to use new RMSUSR.R36 from FTS project. QAR 20.
RMSUSR.R36 and DAPPER.B36 )%
edit (%o'42', '29-Dec-82', 'Charlotte L. Richardson')
%( Have CONSTRUCT_FILESPEC always insert :: into the file specification.
This will allow the DAP code to correctly handle missing node names.
QAR 26. DAPPER.B36 )%
edit (%o'43', '29-Dec-82', 'Charlotte L. Richardson')
%( Teach DAPPER.B36 that RAB USZ field is in WORDS, not BYTES. QAR 24.
DAPPER.B36 )%
edit (%o'50', '6-Jan-83', 'Charlotte L. Richardson')
%( Update copyright notices. DAPPER.B36 )%
edit (%o'52', '17-Jan-83', 'Charlotte L. Richardson')
%( Use DDB's macro EVERYWHERE to avoid bad argument-accessing code generated
as a Bliss "feature". ALL routines in DAPPER.B36 )%
edit (%o'53', '18-Jan-83', 'Charlotte L. Richardson')
%( Fix typo in edit 52. DAPPER.B36. QAR 33 )%
new_version (2, 0)
Edit (%O'65', '11-Apr-84', 'Sandy Clemens')
%( Add DIT V2 files to DT2:. FILES: DITHST.BLI, DAPPER.B36, TTT.MAC.
This edit adds the following changes to DAPPER.B36 made by Doug Rayner:
Have the various routines do a R$CLOSE on the FAB if the R$OPEN
fails. This makes sure that the DECnet logical link gets closed.
After the R$OPEN in ROPEN, reset the BSZ field of the FAB to 7 for
ASCII mode access. In some cases the opening of the link to a remote
FAL (TOPS-10, at least can cause this) can set the byte size to 8-bits.
)%
Edit (%O'104', '8-Oct-84', 'Sandy Clemens')
%( Add new format of COPYRIGHT notice. FILES: ALL )%
! End of revision history
mark_versions ('DIT')
%sbttl 'Table of Contents';
!
! TABLE OF CONTENTS:
!
FORWARD ROUTINE
ROPEN: FORTRAN_FUNC, ! Open a remote file (11).
RREAD: FORTRAN_FUNC, ! Read a remote file (18).
RWRITE: FORTRAN_FUNC, ! Write to a remote file (17).
RCLOSE: FORTRAN_FUNC, ! Close a remote file (12).
RDEL: FORTRAN_FUNC, ! Delete a remote file (13).
RSUB: FORTRAN_FUNC, ! Submit remote file for batch processing (14).
RRENM: FORTRAN_FUNC, ! Rename a remote file (19).
RDIRS: FORTRAN_FUNC, ! Set up to do a remote directory listing (16A).
RDIR: FORTRAN_FUNC, ! Perform a remote directory listing (16B).
RPRINT: FORTRAN_FUNC, ! Print a remote file (15).
DAPERR: RMS$ERCAL NOVALUE, ! Error routine for DAP interface errors.
CONSTRUCT_FILESPEC: NOVALUE, ! Construct embedded file specification
COUNTEM; ! Count significant characters in a string
%sbttl 'Macro Definitions';
!
! Macro definitions:
!
MACRO
! Reference to start of any block, so we don't have to worry if this is a
! real block or a REF of one (sigh).
$ = 0, 0, 0, 0 %,
! Return a value:
DO_RETURN (val) = (return (DILRET (val))) %;
! Status value:
KEYWORDMACRO
sts$value (severity = STS$K_SEVERE, ! Severity code (severe,
! ... warning, info, success)
code, ! Code
fac_sp = 1, ! Default is facility-specific
fac_no = 233, ! Default to DIT
cust_def = 0) = ! Default is Digital-defined
(position_field (sts$m_severity, severity) OR
position_field (sts$m_code , code ) OR
position_field (sts$m_fac_sp , fac_sp ) OR
position_field (sts$m_fac_no , fac_no ) OR
position_field (sts$m_cust_def, cust_def)) %;
%sbttl 'Literals';
!
! Literals
!
LITERAL
! Useful constants:
TRUE = -1, ! Use these so that multiple
FALSE = 0, !... bits can be set at once.
! Maximum number of files:
MAXFILES = 20,
! Field sizes:
USERID_SIZE = 39,
PASSWD_SIZE = 39,
ACCT_SIZE = 39,
FSPEC_SIZE = 39,
! Length of embedded file specification:
! Node name 16
! " 1
! userid USERID_SIZE
! <space> 1
! password PASSWD_SIZE
! <space> 1
! account ACCT_SIZE
! " 1
! :: 2
! regular filespec FSPEC_SIZE
! TOTAL 178
WHOLESPEC_SIZE =178,
! File open modes:
M_MIN = 1,
M_READ = 1,
M_WRITE = 2,
M_APPEND = 3,
M_MAX = 3,
! File type codes:
T_MIN = 0,
T_UNDEFINED = 0,
T_ASCII = 1,
T_IMAGE = 2,
![33] Remove commenting characters when MACY11 is to be supported.
![33] Also change interface files.
!T_MACY11 = 3,
!T_MAX = 3,
T_MAX = 2,
! Record formats:
F_MIN = 0,
F_UNDEFINED = 0,
F_FIXED = 1,
F_VARIABLE = 2,
F_VFC = 3,
F_STREAM = 4,
F_MAX = 4,
! Record attributes:
A_MIN = 0,
A_UNSPECIFIED = 0,
A_ENVELOPE = 1,
A_PRINT = 2,
A_FORTRAN = 3,
A_MACY11 = 4,
A_MAX = 4,
! Close options:
O_MIN = 0,
O_NOTHING = 0,
O_SUBMIT = 1,
O_PRINT = 2,
O_3 = 3, ! Reserved
O_DELETE = 4,
O_SUB_DEL = 5,
O_PRINT_DEL = 6,
O_MAX = 6,
! Status values for error returns:
DIT$_HORRIBLE = ! SYSERR
STS$VALUE (SEVERITY = STS$K_SEVERE, CODE = 1),
DIT$_TOOMANY = ![25] TOOMNY
STS$VALUE (SEVERITY = STS$K_SEVERE, CODE = 2),
DIT$_INVARG = ! INVARG
STS$VALUE (SEVERITY = STS$K_SEVERE, CODE = 3),
DIT$_NETOPRFAIL = ! NETFAL
STS$VALUE (SEVERITY = STS$K_SEVERE, CODE = 4),
DIT$_CHECKSUM = ! CHKSUM
STS$VALUE (SEVERITY = STS$K_SEVERE, CODE = 5),
DIT$_UNSFILETYPE = ! UNSTYP
STS$VALUE (SEVERITY = STS$K_ERROR, CODE = 6),
DIT$_FILEINUSE = ! FILIU
STS$VALUE (SEVERITY = STS$K_SEVERE, CODE = 7),
DIT$_NOFILE = ! NOFILE
STS$VALUE (SEVERITY = STS$K_SEVERE, CODE = 8),
DIT$_EOF = ! DITEOF
STS$VALUE (SEVERITY = STS$K_WARNING, CODE = 9),
DIT$_OVERRUN = ! OVRRUN
STS$VALUE (SEVERITY = STS$K_WARNING, CODE = 10),
DIT$_NOMOREFILES = ! NOMORE
STS$VALUE (SEVERITY = STS$K_INFO, CODE = 11),
! Reserved for DAP up to 100.
! Catch-all for unexpected errors from all routines:
HORRIBLE = DIT$_HORRIBLE,
! ROPEN return codes:
ROP$TOO_MUCH = DIT$_TOOMANY, ![25]
ROP$WRONG_TYPE = DIT$_INVARG,
ROP$OK = SS$_NORMAL,
ROP$NO_NETWORK = DIT$_NETOPRFAIL,
ROP$CHECKSUM = DIT$_CHECKSUM,
ROP$BAD_TYPE = DIT$_UNSFILETYPE,
ROP$FILE_ACT = DIT$_FILEINUSE,
ROP$NO_FILE = DIT$_NOFILE,
! RREAD return codes:
RRE$WRONG_TYPE = DIT$_INVARG,
RRE$OK = SS$_NORMAL,
RRE$NO_NETWORK = DIT$_NETOPRFAIL,
RRE$CHECKSUM = DIT$_CHECKSUM,
RRE$EOF = DIT$_EOF,
RRE$OVERRUN = DIT$_OVERRUN,
! RWRITE return codes:
RWR$WRONG_TYPE = DIT$_INVARG,
RWR$OK = SS$_NORMAL,
RWR$NO_NETWORK = DIT$_NETOPRFAIL,
RWR$CHECKSUM = DIT$_CHECKSUM,
RWR$NO_FILE = DIT$_NOFILE,
! RCLOSE return codes:
RCL$WRONG_TYPE = DIT$_INVARG,
RCL$OK = SS$_NORMAL,
RCL$NO_NETWORK = DIT$_NETOPRFAIL,
RCL$CHECKSUM = DIT$_CHECKSUM,
! RDEL return codes:
RDE$WRONG_TYPE = DIT$_INVARG,
RDE$OK = SS$_NORMAL,
RDE$NO_NETWORK = DIT$_NETOPRFAIL,
RDE$CHECKSUM = DIT$_CHECKSUM,
RDE$NO_FILE = DIT$_NOFILE,
! RSUB return codes:
RSU$WRONG_TYPE = DIT$_INVARG,
RSU$OK = SS$_NORMAL,
RSU$NO_NETWORK = DIT$_NETOPRFAIL,
RSU$CHECKSUM = DIT$_CHECKSUM,
RSU$NO_FILE = DIT$_NOFILE,
! RRENM return codes:
RRN$WRONG_TYPE = DIT$_INVARG,
RRN$OK = SS$_NORMAL,
RRN$NO_NETWORK = DIT$_NETOPRFAIL,
RRN$CHECKSUM = DIT$_CHECKSUM,
RRN$NO_FILE = DIT$_NOFILE,
! RDIRS return codes:
RDS$WRONG_TYPE = DIT$_INVARG,
RDS$OK = SS$_NORMAL,
RDS$NO_NETWORK = DIT$_NETOPRFAIL,
RDS$CHECKSUM = DIT$_CHECKSUM,
RDS$NO_FILE = DIT$_NOFILE,
! RDIR return codes:
RDR$WRONG_TYPE = DIT$_INVARG,
RDR$OK = SS$_NORMAL,
RDR$NO_NETWORK = DIT$_NETOPRFAIL,
RDR$NO_MORE = DIT$_NOMOREFILES,
RDR$NO_FILE = DIT$_NOFILE,
! RPRINT return codes:
RPR$WRONG_TYPE = DIT$_INVARG,
RPR$OK = SS$_NORMAL,
RPR$NO_NETWORK = DIT$_NETOPRFAIL,
RPR$CHECKSUM = DIT$_CHECKSUM,
RPR$NO_FILE = DIT$_NOFILE;
%sbttl 'Data Structures';
!
! Data structures:
!
! File status, one for each of MAXFILES files:
$FIELD file_status_block =
SET
in_use = [$BIT],
file_type = [$INTEGER]
TES;
LITERAL
file_status_block_size = $FIELD_SET_SIZE;
! Whole embedded file specification:
$FIELD wholespec_fields =
SET
spec = [$STRING (WHOLESPEC_SIZE)]
TES;
LITERAL
wholespec_len = $FIELD_SET_SIZE;
! Standard 10/20 calling sequence fields:
FIELD scs_arg_fields =
SET
scs$v_type = [0, 23, 4, 0], ! Type of argument
scs$v_adr = [0, 0, 23, 0] ! Address
TES;
MACRO
scs_arg = BLOCK [1] FIELD (SCS_ARG_FIELDS) %;
! Values for type code:
LITERAL
SCS$K_FOR36_BOOL = %O'01', ! Boolean
SCS$K_SBF36 = %O'02', ! One-word integer
SCS$K_FLOAT36 = %O'04', ! One-word floating
SCS$K_RTNADR = %O'07', ! Routine address
SCS$K_FLOAT72 = %O'10', ! 2-word float (not G)
SCS$K_SBF72 = %O'11', ! 2-word integer
SCS$K_FCMPLX36 = %O'14', ! Single-precision complex
SCS$K_DISPLAY = %O'15', ! COBOL string descriptor
SCS$K_ASCIZ = %O'17'; ! ASCIZ string
! COBOL byte string descriptor:
FIELD scs_descriptor_fields =
SET
scs$v_bytpntr = [0, 0, 36, 0], ! Byte pointer
scs$v_bytsiz = [0, 24, 6, 0], ! Byte size
scs$v_numflg = [1, 35, 1, 0], ! (?)
scs$v_pscalflg = [1, 23, 1, 0], ! (?)
scs$v_scalfac = [1, 18, 5, 1], ! (?)
scs$v_lng = [1, 0, 18, 0] ! Length
TES;
MACRO
SCS_DESCR = BLOCK [2] FIELD (SCS_DESCRIPTOR_FIELDS) %;
! For binding something to a string pointer which could be a COBOL byte string:
MACRO
GET_STRING (scs_parameter) =
(if .scs_parameter [SCS$V_TYPE] eql SCS$K_DISPLAY
then ! COBOL byte string
.(dixadr (.scs_parameter [SCS$V_ADR])) ![52]
else ! Some other type, so make byte pointer
POINT ((dixadr (.scs_parameter)), 36, 7, 0, 0))%;![52]
! Get the address from something which may be a byte pointer:
MACRO
GET_STRING_ADDRESS (scs_parameter) =
(dixadr (.scs_parameter)) %; ![52]
![7] Insert at end of parameter-handling macros:
![7] Force ASCII or an error if this is a byte pointer:
MACRO ![7]
FORCE_ASCII (scs_parameter, error) = ![7]
(BIND real_arg = .scs_parameter [SCS$V_ADR]: SCS_DESCR; ![7]
if .scs_parameter [SCS$V_TYPE] eql SCS$K_DISPLAY ![7]
then ![7] COBOL byte string, check byte size
if .real_arg [SCS$V_BYTSIZ] neq 7 ![7]
then DO_RETURN (error)) %; ![7]
%sbttl 'RMS Data Structures';
! File Access Block:
!=========================================================================!
! FAB$H_BID ! FAB$H_BLN !
!-------------------------------------------------------------------------!
! FAB$H_STS ! FAB$H_STV !
!-------------------------------------------------------------------------!
! FAB$G_CTX !
!-------------------------------------------------------------------------!
! FAB$A_IFI ! FAB$H_JFN !
!-------------------------------------------------------------------------!
! FAB$H_FAC ! FAB$H_SHR !
!-------------------------------------------------------------------------!
! FAB$H_FOP ! Z_ORG ! FAB$Z_BSZ ! FAB$Z_BLS !
!-------------------------------------------------------------------------!
! FAB$A_FNA !
!-------------------------------------------------------------------------!
! FAB$H_RAT ! FAB$H_MRS !
!-------------------------------------------------------------------------!
! FAB$G_MRN !
!-------------------------------------------------------------------------!
! FAB$Z_UNUSED_0 !FAB$Z_FSZ! FAB$Z_BKS !FAB$Z_RFM !
!-------------------------------------------------------------------------!
! FAB$A_JNL ! FAB$A_XAB !
!-------------------------------------------------------------------------!
! FAB$H_DEV ! FAB$H_SDC !
!-------------------------------------------------------------------------!
! FAB$A_TYP ! FAB$A_NAM !
!-------------------------------------------------------------------------!
! FAB$G_ALQ !
!-------------------------------------------------------------------------!
! FAB$G_UNUSED_3 !
!-------------------------------------------------------------------------!
! FAB$G_UNUSED_4 !
!=========================================================================!
! FAB$G_ALQ (reserved for allocation quantity) (FTS)
! FAB$H_BID Block identifier (static)
! FAB$B_BID_1 (FTS)
! FAB$V_DEV_REMOTE File is on a remote system (FTS)
! FAB$Z_BKS Default bucket size (for relative or indexed files)
! FAB$H_BLN Block length (static), length of the FAB
! FAB$Z_BLS Block size (only input for magtapes)
! FAB$Z_BSZ File byte size
! FAB$G_CTX User context word (user data for completion routine in program)
! [Continued on next page ]
! FAB$H_DEV Device characteristics (not set by user):
! FAB$V_DEV_CCL Carriage control device
! FAB$V_DEV_MDI ?
! FAB$V_DEV_REC Record-oriented device (sequential)
! FAB$V_DEV_SQD Sequential block-oriented device
! FAB$V_DEV_TRM Terminal device
! FAB$H_FAC File access (NIL for quick and dirty read):
! FAB$V_FAC_GET Read access
! FAB$V_FAC_UPD Update access
! FAB$V_FAC_PUT Write access
! FAB$V_FAC_DEL Delete access
! FAB$V_FAC_TRN Truncate access
! FAB$V_FAC_BIO Block-mode I/O (FTS)
! FAB$V_FAC_BRO Block and record I/O (FTS)
! FAB$V_FAC_APP Append only (FTS)
! FAB$A_FNA File specification string byte pointer
! FAB$H_FOP File-processing options:
! FAB$V_FOP_WAT Wait for file access
! FAB$V_FOP_CIF Create if nonexistent
! FAB$V_FOP_DRJ Do not release JFN
! FAB$V_FOP_DFW Deferred write to file
! FAB$V_FOP_SUP Supersede existing file (FTS)
! FAB$V_FOP_SPL Print on close (FTS)
! FAB$V_FOP_SCF Submit on close (FTS)
! FAB$V_FOP_DLT Delete on close (FTS)
! FAB$V_FOP_NAM Use NAM block to open file (FTS)
! FAB$V_FOP_CTG File is contiguous (FTS)
! FAB$V_FOP_LKO Override lock (FTS)
! FAB$V_FOP_TMP Temporary file (FTS)
! FAB$V_FOP_MKD Mark for delete (FTS)
! FAB$Z_FSZ Fixed header size (FTS)
! FAB$A_IFI Internal file identifier (not set by user) (address of FST)
! FAB$H_JFN User's JFN, if offered
! FAB$A_JNL Address of log block
! FAB$G_MRN Maximum record number
! FAB$H_MRS Maximum record size
! FAB$A_NAM Address of NAM block (FTS)
! FAB$Z_ORG File organization (REL, IDX, SEQ)
! FAB$H_RAT Record attributes (BLK, MACY11)
! FAB$V_RAT_BLK Blocked records
! FAB$V_RAT_MACY11 MACY11 format (FTS)
! FAB$V_RAT_FTN Fortran carriage control (FTS)
! FAB$V_RAT_CR Implied <LF><CR> envelope (FTS)
! FAB$V_RAT_PRN VMS print file (FTS)
! FAB$V_RAT_EMB Embedded carriage control (FTS)
! FAB$V_RAT_CBL COBOL carriage control (FTS)
! FAB$Z_RFM Record format (FIX, VAR, LSA, STM)
! FAB$H_SDC Spooling device characteristics (not set by user)
! FAB$H_SHR File sharing (PUT, GET, DEL, UPD, NIL, TRN)
! FAB$H_STS Primary completion status code (not set by user)
! FAB$H_STV Secondary status values (not set by user)
! FAB$A_TYP Address of TYP block (FTS)
! FAB$A_XAB Extended attribute block (XAB) address
! Record Access Block:
!=========================================================================!
! RAB$H_BID ! RAB$H_BLN !
!-------------------------------------------------------------------------!
! RAB$H_STS ! RAB$H_STV !
!-------------------------------------------------------------------------!
! RAB$G_CTX !
!-------------------------------------------------------------------------!
! RAB$A_ISI ! RAB$A_FAB !
!-------------------------------------------------------------------------!
! RAB$Z_RAC ! RAB$Z_MBF ! RAB$H_ROP !
!-------------------------------------------------------------------------!
! RAB$A_UBF !
!-------------------------------------------------------------------------!
! RAB$A_RBF !
!-------------------------------------------------------------------------!
! RAB$H_RSZ ! RAB$H_USZ !
!-------------------------------------------------------------------------!
! RAB$G_RFA !
!-------------------------------------------------------------------------!
! RAB$Z_KRF ! RAB$Z_KSZ ! RAB$H_LSN !
!-------------------------------------------------------------------------!
! RAB$A_KBF !
!-------------------------------------------------------------------------!
! RAB$G_BKT !
!-------------------------------------------------------------------------!
! RAB$Z_PAD ! RAB$Z_UNUSED_0 !
!-------------------------------------------------------------------------!
! RAB$G_UNUSED_1 !
!-------------------------------------------------------------------------!
! RAB$G_UNUSED_2 !
!-------------------------------------------------------------------------!
! RAB$G_UNUSED_3 !
!=========================================================================!
! RAB$H_BID Block identifier, identifies block as RAB, cannot be changed
! RAB$G_BKT Bucket hash code
! RAB$H_BLN Block length of the RAB, cannot be altered by user
! RAB$G_CTX User context field
! RAB$A_FAB File Access Block address
! RAB$A_ISI Internal stream identifier (not set by user)
! RAB$A_KBF Key buffer address
! RAB$Z_KRF Key of reference
! RAB$Z_KSZ Key size
! RAB$H_LSN Line sequence number
! RAB$Z_MBF Multibuffer count
! RAB$Z_PAD Padding character
! RAB$Z_RAC Record access mode (SEQ, KEY, RFA, TRA, BFT)
! RAB$A_RBF Record address (NOT byte pointer!)
! [Continued on next page]
! RAB$G_RFA Record's file address
! RAB$H_ROP Record-processing options:
! RAB$V_ROP_EOF Set to EOF on $CONNECT
! RAB$V_ROP_FDL Fast delete
! RAB$V_ROP_LOC Use locate mode on $GETs
! RAB$V_ROP_RAH Read ahead
! RAB$V_ROP_LOA Use load limits
! RAB$V_ROP_WBH Write behind
! RAB$V_ROP_KGT Search key greater
! RAB$V_ROP_KGE Search key greater than or equal to
! RAB$V_ROP_PAD Use pad character as filler
! RAB$V_ROP_NRP Set NRP on $FIND
! RAB$V_ROP_UIF Update existing (FTS)
! RAB$V_ROP_ULK Manual unlock (FTS)
! RAB$V_ROP_TPT Truncate to EOF (FTS)
! RAB$V_ROP_NLK Do not lock (FTS)
! RAB$V_ROP_RLK Read locked record (FTS)
! RAB$V_ROP_BIO Block I/O (FTS)
! RAB$V_ROP_LIM Key limit (FTS)
! RAB$V_ROP_NXR Nonexistent record (FTS)
! RAB$H_RSZ Record size (bytes)
! RAB$H_STS Primary completion status code (not set by user)
! RAB$H_STV Status value (not set by user)
! RAB$A_UBF User record area address (NOT byte pointer)
! RAB$H_USZ User record area size (words)
! Allocation-control XAB:
!=======================================================!
! XABALL$H_BID ! XABALL$H_BLN !
!-------------------------------------------------------!
! XABALL$Z_UNUSED_0 ! Z_COD ! XABALL$A_NXT !
!-------------------------------------------------------!
! XABALL$Z_UNUSED_1 !XABALL$Z_AID !XABALL$Z_BKZ !
!-------------------------------------------------------!
! XABALL$G_UNUSED_2 !
!-------------------------------------------------------!
! XABALL$G_UNUSED_3 !
!-------------------------------------------------------!
! XABALL$G_UNUSED_4 !
!=======================================================!
! XABALL$Z_AID Area identification number
! XABALL$H_BID Block type
! XABALL$Z_BKZ Bucket size
! XABALL$H_BLN Block length (not set by user)
! XABALL$Z_COD XAB type code (static)
! XABALL$A_NXT Next XAB address
! Summary XAB:
!=======================================================!
! XABSUM$H_BID ! XABSUM$H_BLN !
!-------------------------------------------------------!
! XABSUM$Z_UNUSED_0 ! Z_COD ! XABSUM$A_NXT !
!-------------------------------------------------------!
! XABSUM$H_UNUSED_1 !XABSUM$Z_NOK !XABSUM$Z_NOA !
!-------------------------------------------------------!
! XABSUM$G_UNUSED_2 !
!-------------------------------------------------------!
! XABSUM$G_UNUSED_3 !
!-------------------------------------------------------!
! XABSUM$G_UNUSED_4 !
!=======================================================!
! XABSUM$H_BID Block type
! XABSUM$H_BLN Block length
! XABSUM$Z_COD XAB type code
! XABALL$Z_NOA Number of allocation areas defined for the file
! XABSUM$Z_NOK Number of keys defined for the file
! XABSUM$A_NXT Next XAB address
! Date and time XAB:
!=======================================================!
! XABDAT$H_BID ! XABDAT$H_BLN !
!-------------------------------------------------------!
! XABDAT$Z_UNUSED_0 ! Z_COD ! XABDAT$A_NXT !
!-------------------------------------------------------!
! XABDAT$G_CDT !
!-------------------------------------------------------!
! XABDAT$G_RDT !
!-------------------------------------------------------!
! XABDAT$G_EDT !
!=======================================================!
! XABDAT$H_BID Block type
! XABDAT$H_BLN Block length
! XABDAT$G_CDT Creation date and time
! XABDAT$Z_COD XAB type code
! XABDAT$G_EDT Expiration (deletion) date and time
! XABDAT$A_NXT Next XAB address
! XABDAT$G_RDT Revision (read) date and time
! Key definition XAB:
!=======================================================!
! XABKEY$H_BID ! XABKEY$H_BLN !
!-------------------------------------------------------!
! XABKEY$Z_UNUSED_0 ! Z_COD ! XABKEY$A_NXT !
!-------------------------------------------------------!
!XABKEY$Z_UNUSED_1! Z_DTP ! XABKEY$H_FLG !
!-------------------------------------------------------!
!XABKEY$Z_IAN !XABKEY$Z_DAN !XABKEY$Z_LAN !XABKEY$Z_REF !
!-------------------------------------------------------!
! XABKEY$H_IFL ! XABKEY$H_DFL !
!-------------------------------------------------------!
! XABKEY$A_KNM !
!-------------------------------------------------------!
! XABKEY$G_RES0 (reserved) !
!-------------------------------------------------------!
! XABKEY$G_RES1 (reserved) !
!-------------------------------------------------------!
! XABKEY$G_UNUSED_2 !
!-------------------------------------------------------!
! XABKEY$G_UNUSED_3 !
!-------------------------------------------------------!
! XABKEY$G_UNUSED_4 !
!-------------------------------------------------------!
! XABKEY$H_POS0 ! XABKEY$H_SIZ0 !
!-------------------------------------------------------!
! XABKEY$H_POS1 ! XABKEY$H_SIZ1 !
!-------------------------------------------------------!
! XABKEY$H_POS2 ! XABKEY$H_SIZ2 !
!-------------------------------------------------------!
! XABKEY$H_POS3 ! XABKEY$H_SIZ3 !
!-------------------------------------------------------!
! XABKEY$H_POS4 ! XABKEY$H_SIZ4 !
!-------------------------------------------------------!
! XABKEY$H_POS5 ! XABKEY$H_SIZ5 !
!-------------------------------------------------------!
! XABKEY$H_POS6 ! XABKEY$H_SIZ6 !
!-------------------------------------------------------!
! XABKEY$H_POS7 ! XABKEY$H_SIZ7 !
!=======================================================!
! [Continued on next page]
! XABKEY$H_BID Block type
! XABKEY$H_BLN Block length
! XABKEY$Z_COD XAB type code
! XABKEY$Z_DAN Data bucket area number
! XABKEY$H_DFL Data bucket file size (limit)
! XABKEY$Z_DTP Data type of the key (STG, EBC, SIX)
! XABKEY$H_FLG Key flags
! XABKEY$V_FLG_DUP Duplicate keys allowed
! XABKEY$V_FLG_CHG Change of key allowed
! XABKEY$V_FLG_HSH Hash method of index org.
! XABKEY$Z_IAN Index buckets area number
! XABKEY$H_IFL Index bucket file size (limit)
! XABKEY$A_KNM Key name buffer address
! XABKEY$Z_LAN Lowest level of index area number
! XABKEY$A_NXT Address of next XAB in chain
! XABKEY$H_POSn Key position (0 through 7)
! XABKEY$Z_REF Key of reference
! XABKEY$H_SIZn Key size (0 through 7)
! Name Block (only really needed for wildcarding):
!=========================================================================!
! NAM$H_BID ! NAM$H_BLN !
!-------------------------------------------------------------------------!
! NAM$A_ESA !
!-------------------------------------------------------------------------!
! NAM$H_ESL ! NAM$H_ESS !
!-------------------------------------------------------------------------!
! NAM$A_RLF !
!-------------------------------------------------------------------------!
! NAM$A_RSA !
!-------------------------------------------------------------------------!
! NAM$H_RSS ! NAM$H_RSL !
!-------------------------------------------------------------------------!
! NAM$G_FNB !
!-------------------------------------------------------------------------!
! NAM$T_NODE !
!-------------------------------------------------------------------------!
! NAM$T_USERID !
!-------------------------------------------------------------------------!
! NAM$T_PASSWORD !
!-------------------------------------------------------------------------!
! NAM$T_ACCOUNT !
!-------------------------------------------------------------------------!
! NAM$T_OPTIONAL_DATA !
!-------------------------------------------------------------------------!
! NAM$T_DVI !
!-------------------------------------------------------------------------!
! NAM$T_DIR !
!-------------------------------------------------------------------------!
! NAM$T_NAM !
!-------------------------------------------------------------------------!
! NAM$T_EXT !
!-------------------------------------------------------------------------!
! NAM$T_VER !
!-------------------------------------------------------------------------!
! NAM$G_WCC !
!-------------------------------------------------------------------------!
! ! NAM$Z_CHA !
!=========================================================================!
! [Continued on next page]
! NAM$T_ACCOUNT Account
! NAM$H_BID Block identifier (not set by user)
! NAM$H_BLN Block length (not set by user)
! NAM$Z_CHA What changed (EXT, NAM, DIR, STR)
! NAM$T_DIR Directory
! NAM$T_DVI Device identification (not set by user)
! NAM$A_ESA Expanded string area address
! NAM$H_ESL Expanded string length (not set by user)
! NAM$H_ESS Expanded string area size
! NAM$T_EXT Extension
! NAM$G_FNB File name status bits (not set by user):
! NAM$V_FNB_ACT Account given
! NAM$V_FNB_DEV Wildcard in device
! NAM$V_FNB_DIR Wildcard in directory
! NAM$V_FNB_EXT Wildcard in extension
! NAM$V_FNB_GND Ignore deleted files
! NAM$V_FNB_INV Ignore invisible files
! NAM$V_FNB_NAM Wildcard in filename
! NAM$V_FNB_NHV Next higher generation
! NAM$V_FNB_NODE File specification includes a node name
! NAM$V_FNB_PRO Protection given
! NAM$V_FNB_QUOTED File specification includes a quoted string
! NAM$V_FNB_TFS Temporary file
! NAM$V_FNB_UHV Highest generation
! NAM$V_FNB_ULV Lowest generation
! NAM$V_FNB_UNT Wildcard in unit number (never)
! NAM$V_FNB_VER Wildcard in generation number
! NAM$V_FNB_WILDCARD File specification string includes a wildcard
! NAM$T_NAM Name
! NAM$T_NODE Node name
! NAM$T_OPTIONAL_DATA Optional data
! NAM$T_PASSWORD Password
! NAM$A_RLF Related file NAM block address
! NAM$A_RSA Resultant string area address
! NAM$H_RSL Resultant string length (not set by user)
! NAM$H_RSS Resultant string area size
! NAM$T_USERID Userid
! NAM$T_VER Version number
! NAM$G_WCC Wildcard context (not set by user)
! TYPE block (needed if data type is not ASCII):
!=========================================================================!
! TYP$H_BID ! TYP$H_BLN !
!-------------------------------------------------------------------------!
! TYP$H_CODE ! TYP$H_CLASS !
!-------------------------------------------------------------------------!
! ! TYP$B_SCALE ! TYP$H_LENGTH !
!-------------------------------------------------------------------------!
! TYP$A_MORE ! TYP$A_NEXT !
!=========================================================================!
! TYP$H_BID Block identifier
! TYP$H_BLN Block length
! TYP$H_CLASS Data type (ASCII, IMAGE, MACY11)
! TYP$H_CODE Reserved for secondary data type
! TYP$H_LENGTH Reserved for length of field
! TYP$A_MORE Alternate chain (multiple record formats)
! TYP$A_NEXT Descriptor for next field
! TYP$B_SCALE Reserved for scale factor
%sbttl 'Own Storage';
!
! Own storage:
!
OWN
! File status:
! in_use TRUE if this file is in use
! file_type T_ASCII, T_IMAGE, or T_UNDEFINED
file_status: BLOCKVECTOR [MAXFILES, file_status_block_size]
FIELD (file_status_block),
! File Access Blocks: Describe files and contain file-related information.
fabs: BLOCKVECTOR [MAXFILES, FAB$K_BLN]
FIELD ($FAB_BLOCK_FIELDS),
! Record Access Blocks: Describe records and contain record-related information.
rabs: BLOCKVECTOR [MAXFILES, RAB$K_BLN]
FIELD ($RAB_BLOCK_FIELDS),
! Type blocks:
types: BLOCKVECTOR [MAXFILES, TYP$K_BLN]
FIELD ($TYP_BLOCK_FIELDS),
! Complete embedded file specifications:
wholespec: BLOCKVECTOR [MAXFILES, WHOLESPEC_LEN]
FIELD (WHOLESPEC_FIELDS),
! FAB for directory:
dirfab: $FAB_DECL,
! FAB for other static uses:
afab: $FAB_DECL,
dfab: $FAB_DECL,
! Embedded file specifications:
dirspec: BLOCK [WHOLESPEC_LEN] FIELD (WHOLESPEC_FIELDS),
wholespeca: BLOCK [WHOLESPEC_LEN] FIELD (WHOLESPEC_FIELDS),
wholespecd: BLOCK [WHOLESPEC_LEN] FIELD (WHOLESPEC_FIELDS);
%sbttl 'Builtins';
![52]
![52] Builtins
![52]
BUILTIN POINT; ![52] Generate a real honest-to-goodness bptr
%sbttl 'External References';
!
! External references:
!
EXTERNAL ROUTINE
DIXADR, ![52] DIX$$GET_ARGADR Get by-reference
![52] argument address (Bliss makes bad code)
R$OPEN, ! Open an existing local or remote file.
R$CREATE, ! Open a new local or remote file.
R$ERASE, ! Delete a local or remote file.
R$CLOSE, ! Close a local or remote file.
R$GET, ! Get a record from an open file.
R$PUT, ! Write a record to an open file.
R$DIRECTORY, ! Open a directory for listing.
R$SEARCH, ! Get directory information for a file.
R$LIST, ! Create directory listing line.
R$RENAME, ! Rename a file.
R$CONNECT, ! Connect FAB to RAB.
DILRET; ! Return status values
%sbttl 'ROPEN: Open a remote file (11)'
GLOBAL ROUTINE ROPEN (fnumber, fname, userid, passwd, acct, mode,
dtype, rformat, rattrs, rsize, runits): FORTRAN_FUNC =
!++
! FUNCTIONAL DESCRIPTION:
! Open a remote or local file for sequential processing.
!
! FORMAL PARAMETERS:
! fnumber File number, assigned by this routine.
! fname File name, including node name, in ASCII.
! userid USERID_SIZE ASCII character user code.
! passwd PASSWD_SIZE character ASCII password.
! acct ACCT_SIZE ASCII character account.
! mode Mode to open file:
! M_READ to read,
! M_WRITE to write,
! M_APPEND to append.
! dtype File data type:
! T_UNDEFINED for undefined,
! T_ASCII for ASCII, or
! T_IMAGE for image.
! rformat Record format:
! F_UNDEFINED for undefined,
! F_FIXED for fixed length,
! F_VARIABLE for variable length,
! F_VFC for variable with fixed-length control (VFC),
! or F_STREAM for ASCII stream format.
! rattrs Record attributes:
! A_UNSPECIFIED for unspecified,
! A_ENVELOPE for implied <LF><CR> envelope,
! A_PRINT for VMS printer carriage control,
! A_FORTRAN for Fortran carriage control, or
! A_MACY11 for MACY11 format.
! rsize Record size. The record size, if required, is
! measured in bytes of the size given by the user as the
! record size units.
! runits Record size units, in bits. This parameter is currently
! included only for user convenience and does not affect
! how the data is actually transmitted by the network.
! Zero is assumed to mean characters for ASCII or words
! (on the local system) for image files.
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! ROP$TOO_MUCH if another file cannot be opened. The maximum is
! MAXFILES.
! ROP$WRONG_TYPE if an argument is of the wrong type or is invalid
! Mode, dtype, rformat, or rattrs is out of range, or
! the file name has invalid syntax (RMS$_FSI).
! ROP$OK if the operation succeeded.
! ROP$NO_NETWORK if the network operation could not be done
! (RMS$_CON, RMS$_DPE, RMS$_NLB, RMS$_SUP).
! ROP$CHECKSUM if there was a checksum error (RMS$_CRC).
! ROP$BAD_TYPE if the user-specified file type for writing a file
! cannot be done.
! ROP$FILE_ACT if file activity precludes this operation.
! ROP$NO_FILE if the file does not exist or is not available
! (RMS$_FEX, RMS$_FNF, RMS$_FLK, RMS$_PRV).
! HORRIBLE if some other error occurs.
!
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
BEGIN ! ROPEN
MAP
fname: SCS_ARG,
userid: SCS_ARG,
passwd: SCS_ARG,
acct: SCS_ARG;
BIND
a_fnumber = (dixadr (.fnumber)), ![52]
a_fname = GET_STRING (fname),
a_userid = GET_STRING (userid),
a_passwd = GET_STRING (passwd),
a_acct = GET_STRING (acct), ![52]
a_mode = (dixadr (.mode)), ![52]
a_dtype = (dixadr (.dtype)), ![52]
a_rformat = (dixadr (.rformat)), ![52]
a_rattrs = (dixadr (.rattrs)), ![52]
a_rsize = (dixadr (.rsize)), ![52]
a_runits = (dixadr (.runits)); ![52]
LOCAL
error_code,
rsz;
! TTY_PUT_QUO ('DAP: Entering ROPEN'); TTY_PUT_CRLF ();
! Check parameters.
![7] Check byte pointers for ASCII in ROPEN.
FORCE_ASCII (fname, ROP$WRONG_TYPE); ![7]
FORCE_ASCII (userid, ROP$WRONG_TYPE); ![7]
FORCE_ASCII (passwd, ROP$WRONG_TYPE); ![7]
FORCE_ASCII (acct, ROP$WRONG_TYPE); ![7]
if (.a_mode lss M_MIN) or (.a_mode gtr M_MAX) ![52]
then DO_RETURN (ROP$WRONG_TYPE);
if (.a_dtype lss T_MIN) or (.a_dtype gtr T_MAX) ![52]
then DO_RETURN (ROP$WRONG_TYPE);
if (.a_rformat lss F_MIN) or (.a_rformat gtr F_MAX) ![52]
then DO_RETURN (ROP$WRONG_TYPE);
if (.a_rattrs lss A_MIN) or (.a_rattrs gtr A_MAX) ![52][53]
then DO_RETURN (ROP$WRONG_TYPE);
! Get a file slot.
! TTY_PUT_QUO ('DAP: ROPEN find file slot'); TTY_PUT_CRLF ();
a_fnumber = (incr i from 0 to MAXFILES - 1 do ![52]
if not .file_status [.i, in_use] then exitloop .i);
if (.a_fnumber eql MAXFILES) or (.a_fnumber eql -1) ![52]
then DO_RETURN (ROP$TOO_MUCH);
file_status [.a_fnumber, in_use] = TRUE; ![52]
! Construct embedded file specification.
! TTY_PUT_QUO ('DAP: ROPEN call CONSTRUCT_FILESPEC'); TTY_PUT_CRLF ();
CONSTRUCT_FILESPEC (a_fname, a_userid, a_passwd, a_acct,
wholespec [.a_fnumber, spec]);
! Construct File Access Block.
! FAB input fields:
! BKS Bucket size (ignored if allocation XAB present)
! BLS Blocksize (magtape only)
! FAC File access
! FNA File specification string address
! FOP File-processing options (NAM, SCF, or SPL only for $CREATE)
! IFI Internal file identifier (must be zero)
! MRN Maximum record number (relative organization only)
! MRS Maximum record size
! NAM Name block address
! ORG File organization (REL, IDX, SEQ)
! RAT Record attributes (BLK, MACY11)
! RFM Record format, unit record devices only (FIX, VAR, LSa, STM)
! SHR File sharing (PUT, GET, DEL, UPD, NIL, TRN)
! XAB Extended attribute block address
! FAB output fields:
! BKS Bucket size; not used for sequential files
! BLS Block size (sequential organization only)
! DEV Device characteristics
! FOP File-processing options
! IFI Internal file identifier
! MRN Maximum record number, for relative files only
! MRS Maximum record size
! ORG File organization
! RAT Record attributes
! RFM Record format
! SDC Spooling device characteristics
! STS Completion status code
! STV Status value (I/O channel number)
! NAM input fields:
! DVI Device identification (if NAM bit set in FOP of FAB)
! ESA Expanded string area address
! ESS Expanded string area size
! RLF Related file NAM block address (if nonzero, RSA and RSL are input from
! related file NAM block)
! RSA Resultant string area address
! RSS Resultant string area size
! NAM output fields:
! DVI Device identification
! ESL Expanded string length
! FNB File name status bits
! RSL Resultant string length
! TTY_PUT_QUO ('DAP: ROPEN checking dtype'); TTY_PUT_CRLF ();
if (.a_dtype eql T_IMAGE) ![52]
then ! Image mode
if (.a_runits eql 0) ![52]
then rsz = .a_rsize ![52]
else rsz = (.a_runits * .a_rsize + 1) / 36 ![52]
else ! ASCII or undefined mode
if (.a_runits eql 0) ![52]
then rsz = .a_rsize ![52]
else rsz = (.a_runits * .a_rsize + 1) / 7; ![52]
! TTY_PUT_QUO ('DAP: ROPEN Initialize FAB'); TTY_PUT_CRLF ();
$FAB_INIT (FAB = fabs [.a_fnumber, $], CTX = .a_fnumber, ORG = SEQ, ![52]
FNA = CH$PTR (wholespec [.a_fnumber, $]), MRS = .rsz, ![52]
TYP = types [.a_fnumber, $]); ![52]
! Do type:
! TTY_PUT_QUO ('DAP: ROPEN do type'); TTY_PUT_CRLF ();
file_status [.a_fnumber, file_type] = .a_dtype; ![52]
![33] Change in .a_dtype code in ROPEN CLR 24-Nov-82
case .a_dtype from T_MIN to T_MAX of ![33][52]
SET ![33]
[T_UNDEFINED]: ; ![33]
[T_ASCII]: ![33]
$TYP_INIT (TYP = types [.a_fnumber, $], ![33][52]
CLASS = TYP$K_CLASS_ASCII); ![33] ASCII/undefined
[T_IMAGE]: ![33]
$TYP_INIT (TYP = types [.a_fnumber, $], ![33][52]
CLASS = TYP$K_CLASS_IMAGE); ![33] Image
![33] Remove commenting characters when MACY11 is to be supported.
! [T_MACY11]: ![33]
! $TYP_INIT (TYP = types [.a_fnumber, $], ![33][52]
! CLASS = TYP$K_CLASS_MACY11); ![33] MACY11
TES; ![33]
![33]if ..dtype neq T_IMAGE
![33] then $TYP_INIT (TYP = types [..fnumber, $],
![33] CLASS = TYP$K_CLASS_ASCII) ! ASCII/undefined
![33] else $TYP_INIT (TYP = types [..fnumber, $],
![33] CLASS = TYP$K_CLASS_IMAGE); ! Image
! Do record format:
! TTY_PUT_QUO ('DAP: ROPEN do record format'); TTY_PUT_CRLF ();
case .a_rformat from F_MIN to F_MAX of ![52]
SET
![33] Change in F_UNDEFINED case of .a_rformat in ROPEN CLR 24-Nov-82
![33] [F_UNDEFINED]: ; ! Undefined
[F_UNDEFINED]: ![33] Undefined
$FAB_STORE (FAB = fabs [.a_fnumber, $], RFM = UDF); ![33][52]
[F_FIXED]: ! Fixed length
$FAB_STORE (FAB = fabs [.a_fnumber, $], RFM = FIX); ![52]
[F_VARIABLE]: ! Variable length
$FAB_STORE (FAB = fabs [.a_fnumber, $], RFM = VAR); ![52]
[F_VFC]: ! VFC
$FAB_STORE (FAB = fabs [.a_fnumber, $], RFM = VFC); ![52]
[F_STREAM]: ! ASCII stream
$FAB_STORE (FAB = fabs [.a_fnumber, $], RFM = STM); ![52]
TES;
! Do access mode:
! TTY_PUT_QUO ('DAP: ROPEN do access mode'); TTY_PUT_CRLF ();
if .a_mode neq M_READ
then $FAB_STORE (FAB = fabs [.a_fnumber, $], FAC = PUT) ![52] Not read
else $FAB_STORE (FAB = fabs [.a_fnumber, $], FAC = GET); ![52] Read
! Do record attributes:
! TTY_PUT_QUO ('DAP: ROPEN do record attributes'); TTY_PUT_CRLF ();
case .a_rattrs from A_MIN to A_MAX of ![52]
set
[A_UNSPECIFIED]: ; ! Unspecified
[A_ENVELOPE]: ! Implied <LF><CR> envelope
$FAB_STORE (FAB = fabs [.a_fnumber, $], RAT = CR); ![52]
[A_PRINT]: ! VMS printer carriage control
$FAB_STORE (FAB = fabs [.a_fnumber, $], RAT = PRN); ![52]
[A_FORTRAN]: ! Fortran carriage control
$FAB_STORE (FAB = fabs [.a_fnumber, $], RAT = FTN); ![52]
[A_MACY11]: ! MACY11 format
$FAB_STORE (FAB = fabs [.a_fnumber, $], RAT = MACY11); ![52]
tes;
! Ensure treatment as a remote file.
fabs [.a_fnumber, FAB$V_DEV_REMOTE] = TRUE; ![52]
! Do the operation.
! TTY_PUT_QUO ('DAP: ROPEN Do operation'); TTY_PUT_CRLF ();
case .a_mode from M_MIN to M_MAX of ![52]
set
[M_READ]: ! Read existing file
R$OPEN (fabs [.a_fnumber, $], DAPERR); ![52]
[M_WRITE]: ! Write new file
R$CREATE (fabs [.a_fnumber, $], DAPERR); ![52]
[M_APPEND]: begin ! Append to file
$FAB_STORE (FAB = fabs [.a_fnumber, $], FOP = CIF); ![52]
R$OPEN (fabs [.a_fnumber, $], DAPERR); ![52]
end;
tes;
! TTY_PUT_QUO ('DAP: ROPEN after $CREATE or $OPEN'); TTY_PUT_CRLF ();
!
! Now, depending on who we connected to, we might have had the BSZ field
! changed (FAL-10 is a know culprit). So, for safety sake, in the case
! of an ASCII file, reset the value to 7-bit bytes.
!
IF .a_dtype EQL T_ASCII
THEN
$FAB_STORE (FAB = fabs [.a_fnumber, $], BSZ = 7);
error_code = 0;
selectone .fabs [.a_fnumber, FAB$H_STS] of ![52]
set
[RMS$_NORMAL]: ; ! Operation successful
[RMS$_FEX, ! File already exists
RMS$_FNF, ! File not found
RMS$_FLK, ! File locked; not available
RMS$_PRV]: ! File protection violation
error_code = (ROP$NO_FILE);
[RMS$_FSI]: ! File spec contains invalid syntax
error_code = (ROP$WRONG_TYPE);
[RMS$_CON, ! Can't connect to FAL
RMS$_DPE, ! DAP protocol error
RMS$_NLB, ! Network link broken
RMS$_SUP]: ! Operation not supported on remote system
error_code = (ROP$NO_NETWORK);
! [RMS$_AID, ! Area XABs not ascending by AID value
! RMS$_BKZ, ! BKZ in AREA XAB greater than 31
! RMS$_BLN, ! FAB or entry in XAB chain has bad BLN
! RMS$_CGJ, ! Cannot get JFN for file
! RMS$_COD, ! Entry on XAB chain has bad COD
! RMS$_COF, ! Cannot open file
! RMS$_DAN, ! DAN in KEY XAB greater than highest AID
! RMS$_DEV, ! Device is not disk
! RMS$_DTP, ! DTP in KEY XAB invalid or disagrees
! ! with BSZ of FAB
! RMS$_IAN, ! IAN in KEY XAB greater than highest AID
! RMS$_IMX, ! Multiple copies of DATE or SUMMARY XAB
! RMS$_ORD, ! KEY XABs not in ascending order by REF field
! ! or AREA XABs not in ascending order by AID
! RMS$_RAT, ! BLK specified for stream file
! RMS$_REF, ! KEY XABs are not ascending by REF field value
! RMS$_SIZ]: ! Number of bytes in data key exceeds 255
[OTHERWISE]: error_code = (HORRIBLE);
tes;
IF .error_code NEQ 0
THEN
BEGIN
R$CLOSE (fabs [.a_fnumber, $], DAPERR); !if error on OPEN, close link
DO_RETURN (.error_code);
END;
! Construct Record Access Block.
! TTY_PUT_QUO ('DAP: ROPEN construct RAB'); TTY_PUT_CRLF ();
$RAB_INIT (RAB = rabs [.a_fnumber, $], FAB = fabs [.a_fnumber, $], RAC = TRA);![52][53]
! If APPEND mode, position to EOF.
if .a_mode eql M_APPEND ![52]
then $RAB_STORE (RAB = rabs [.a_fnumber, $], ROP = EOF); ![52]
! Connect RAB to file.
! TTY_PUT_QUO ('DAP: ROPEN connect RAB to FAB'); TTY_PUT_CRLF ();
R$CONNECT (rabs [.a_fnumber, $], DAPERR); ![52]
! TTY_PUT_QUO ('DAP: ROPEN after CONNECT'); TTY_PUT_CRLF ();
error_code = 0;
selectone .rabs [.a_fnumber, RAB$H_STS] of ![52]
set
[RMS$_NORMAL]: ; ! Operation successful
[RMS$_CON, ! Can't connect to FAL
RMS$_DPE, ! DAP protocol error
RMS$_NLB, ! Network link broken
RMS$_SUP]: ! Operation not supported on remote system
error_code = (ROP$NO_NETWORK);
! [RMS$_CCR, ! Cannot connect RAB
! RMS$_IFI, ! Bad IFI value (file not open?)
! RMS$_KRF, ! Bad KRF value
! RMS$_PEF]: ! Cannot position to EOF for append
! ! (file not sequential)
[OTHERWISE]: error_code = (HORRIBLE);
tes;
IF .error_code NEQ 0
THEN
BEGIN
R$CLOSE (fabs [.a_fnumber, $], DAPERR); !if error on OPEN, close link
DO_RETURN (.error_code);
END;
! TTY_PUT_QUO ('DAP: Leaving ROPEN'); TTY_PUT_CRLF ();
DO_RETURN (ROP$OK);
END; ! ROPEN
%sbttl 'RREAD: Read a remote file (18)'
GLOBAL ROUTINE RREAD (fnumber, runits, rmax, data): FORTRAN_FUNC =
!++
! FUNCTIONAL DESCRIPTION:
! Read an ASCII or image record from a file opened by ROPEN.
!
! Note that line sequence numbers and page marks will be removed from
! TOPS10/TOPS20 files which are opened in an ASCII mode. If the user
! needs to read the line sequence numbers as data, he should use an image
! mode, not ASCII.
!
! FORMAL PARAMETERS:
! fnumber File number, from the ROPEN routine.
! runits Data unit size. Ignored if the file is in ASCII;
! otherwise the data length unit size in bits. If
! zero, the data is in words. This parameter is
! currently only included for user convenience and
! does not affect how data is actually shipped
! through the network.
! rmax Maximum record size (or zero), returned as the
! length of data returned, in characters if ASCII
! or in bytes of the data unit size given by the
! user (or words), if image.
! data Data read.
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! RRE$WRONG_TYPE if an argument is of the wrong type or is
! invalid. The file number may be incorrect or
! may refer to a file which is not open.
! RRE$OK if the operation succeeded.
! RRE$NO_NETWORK if the network operation could not be done
! (RMS$_CON, RMS$_DPE, RMS$_NLB, RMS$_SUP).
! RRE$CHECKSUM if there was a checksum error (RMS$_CRC).
! RRE$EOF if end of file occurred (RMS$_EOF).
! RRE$OVERRUN if the record is too large for the user buffer (RMS$_RTB).
! HORRIBLE if some other error occurred.
!
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
BEGIN ! RREAD
MAP
data: SCS_ARG;
BIND
a_fnumber = (dixadr (.fnumber)), ![52]
a_runits = (dixadr (.runits)), ![52]
a_rmax = (dixadr (.rmax)), ![52]
a_data = GET_STRING_ADDRESS (data);
LOCAL
size;
! TTY_PUT_QUO ('DAP: Entering RREAD'); TTY_PUT_CRLF ();
! Check parameters.
if (.a_fnumber lss 0) or (.a_fnumber geq MAXFILES) ![52]
then DO_RETURN (RRE$WRONG_TYPE);
if not .file_status [.a_fnumber, in_use] ![52]
then DO_RETURN (RRE$WRONG_TYPE);
! Initialize the RAB.
! RAB input fields:
! ISI Internal stream identifier
! KBF Key buffer address
! KRF Key of reference
! KSZ Key buffer size
! RAC Record access mode (SEQ, KEY, RFA, TRA, BFT)
! RFA Record's address (only for RAC = RFA)
! ROP Record-processing options (EOF, FDL, LOC, RAH, LOA, WBH, KGT, KGE, PAD, NRP)
! UBF User record area address
! USZ User record area size
! RAB output fields:
! BKT Bucket code (relative record number for relative file accessed
! sequentially)
! RBF Record address
! RFA Record's file address
! RSZ Record size
! STS Completion status code
! STV Status value (termination character for terminal input, or record length
! if record too large for user buffer area)
![43] Correctly set USZ field of RAB before R$GET in RREAD to know that
![43] the value is in words, not bytes.
if .file_status [a_fnumber, file_type] eql T_IMAGE ![52]
then ! Image file type
if .a_runits eql 0 ![52][43] words
then size = .a_rmax ![52][43] Already in words
else size = (.a_rmax * .a_runits + 35) / 36 ![52][43] Convert to words
else ! ASCII or undefined file type
![43] if ..runits eql 0
![43] then size = ..rmax
![43] else size = (..rmax * ..runits + 1) / 7;
size = (.a_rmax + 4) / 5; ![52][43] Convert ASCII bytes to words
$RAB_STORE (RAB = rabs [.a_fnumber, $], UBF = a_data, USZ = .size); ![52]
R$GET (rabs [.a_fnumber, $], DAPERR); ![52]
selectone .rabs [.a_fnumber, RAB$H_STS] of ![52]
set
[RMS$_NORMAL]: ; ! Operation successful
[RMS$_EOF]: ! End of file
DO_RETURN (RRE$EOF);
[RMS$_RTB]: ! Warning: record too large for user buffer
DO_RETURN (RRE$OVERRUN);
[RMS$_CON, ! Can't connect to FAL
RMS$_DPE, ! DAP protocol error
RMS$_NLB, ! Network link broken
RMS$_SUP]: ! Operation not supported on remote system
DO_RETURN (RRE$NO_NETWORK);
! [RMS$_DEL, ! RFA access to deleted record
! RMS$_FAC, ! GET in FAC not set
! RMS$_IOP, ! Key access to SEQ file or RFA access to
! ! stream file
! RMS$_ISI, ! RAB is not connected
! RMS$_KBF, ! No key buffer pointer (only if KEY)
! RMS$_KEY, ! Record number 0 or greater than MRN
! ! (only if KEY and REL)
! RMS$_KRF, ! Invalid key of reference (only if IDX and KEY)
! RMS$_KSZ, ! KSZ greater than key identified by KRF
! RMS$_LSN, ! Line-sequence-number of accessed record is bad
! RMS$_RFA, ! Bad RFA value in RFA field (if RFA)
! RMS$_RLK, ! Record locked by another stream
! RMS$_RNF, ! Record not found
! RMS$_UBF]: ! No user buffer pointer
[OTHERWISE]: DO_RETURN (HORRIBLE);
tes;
![43] Set the "rmax" parameter to indicate how many bytes of size "rsize"
![43] were read, using the RSZ field in the RAB, which is in bytes for ASCII
![43] files or words for image files.
size = .rabs [.a_fnumber, RAB$H_RSZ]; ![43][52]
if .file_status [.a_fnumber, file_type] eql T_IMAGE ![43][52]
then ![43] image file type
if .a_runits eql 0 ![43][52]
then a_rmax = .size ![52][43] image words
else a_rmax = (.size * 36) / .a_runits ![52][43] image bytes
else ![43] ASCII file type
a_rmax = .size; ![52][43] ASCII characters
! TTY_PUT_QUO ('DAP: Leaving RREAD'); TTY_PUT_CRLF ();
DO_RETURN (RRE$OK);
END; ! RREAD
%sbttl 'RWRITE: Write to a remote file (17)'
GLOBAL ROUTINE RWRITE (fnumber, runits, length, data): FORTRAN_FUNC =
!++
! FUNCTIONAL DESCRIPTION:
! Write an ASCII or image record into a file opened by ROPEN.
!
! FORMAL PARAMETERS:
! fnumber File number, from the ROPEN routine.
! runits Data unit size. Ignored if the file is in ASCII;
! otherwise the data length unit size in bits. If
! zero, the data is in words. This parameter currently
! is only included for user convenience and does not
! affect how the data is actually transmitted through
! the network.
! length Length of data. This is the number of characters to
! write, if ASCII, or the number of bytes (or words) of
! the size specified by the user as the data unit size,
! if image.
! data Data to write.
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! RWR$WRONG_TYPE if an argument is of the wrong type or is
! invalid. The file number may be incorrect or may refer to
! a file which is not open.
! RWR$OK if the operation succeeded.
! RWR$NO_NETWORK if the network operation could not be done
! (RMS$_CON, RMS$_DPE, RMS$_NLB, RMS$_SUP).
! RWR$CHECKSUM if there was a checkum error (RMS$_CRC).
! RWR$NO_FILE if the file does not exist or is not available (RMS$_PRV).
! HORRIBLE if some other error occurred.
!
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!--
BEGIN ! RWRITE
MAP
data: SCS_ARG;
BIND
a_fnumber = (dixadr (.fnumber)), ![52]
a_runits = (dixadr (.runits)), ![52]
a_length = (dixadr (.length)), ![52]
a_data = GET_STRING_ADDRESS (data);
LOCAL
size;
! TTY_PUT_QUO ('DAP: Entering RWRITE'); TTY_PUT_CRLF ();
! Check parameters.
if (.a_fnumber lss 0) or (.a_fnumber geq MAXFILES) ![52]
then DO_RETURN (RWR$WRONG_TYPE);
if not .file_status [.a_fnumber, in_use] ![52]
then DO_RETURN (RWR$WRONG_TYPE);
! Initialize the RAB.
! RAB input fields:
! ISI Internal stream identifier
! KBF Key buffer address
! KSZ Key size
! RAC Record access mode (SEQ, KEY, RFA, TRA, BFT)
! RBF Record address
! RSZ Record size (bytes)
! ROP Record-processing options (WBH only)
! RAB output fields:
! BKT Bucket code (set to relative record number for sequential access to
! relative files)
! RFA Record's file address
! STS Completion status code
! STV Status value
![43] Fix RWRITE to know that RSZ field of RAB is in ASCII bytes or words.
if .file_status [.a_fnumber, file_type] eql T_IMAGE ![52]
then ! Image file type
if .a_runits eql 0 ![52]
then size = .a_length ![52][43] words
else size = (.a_length * .a_runits + 35) / 36 ![52][43] make words
else ! ASCII or undefined file type
![43] if ..runits eql 0
![43] then size = ..length
![43] else size = (..length * ..runits + 1) / 7;
size = .a_length; ![52][43] ASCII bytes
$RAB_STORE (RAB = rabs [.a_fnumber, $], RSZ = .size, RBF = a_data); ![52]
R$PUT (rabs [.a_fnumber, $], DAPERR); ![52]
selectone .rabs [.a_fnumber, RAB$H_STS] of ![52]
set
[RMS$_NORMAL]: ; ! Operation successful
[RMS$_PRV]: ! Privilege violation; access denied
DO_RETURN (RWR$NO_FILE);
[RMS$_CON, ! Can't connect to FAL
RMS$_DPE, ! DAP protocol error
RMS$_NLB, ! Network link broken
RMS$_SUP]: ! Operation not supported on remote system
DO_RETURN (RWR$NO_NETWORK);
! [RMS$_OK_DUP, ! Record inserted has duplicate key value
! RMS$_OK_IDX, ! Record successfully inserted, but error
! ! occurred on index update which could cause
! ! slow access
! RMS$_OK_REO, ! Reorganize file
! RMS$_OK_RRV, ! Record inaccessible from secondary index
! RMS$_DUP, ! Duplicate key detected
! RMS$_FAC, ! PUT in FAC not set
! RMS$_FUL, ! File is 256K pages already
! RMS$_IOP, ! Key access to seq file or RFA access to
! ! stream file
! RMS$_ISI, ! Usually means RAB is not connected
! RMS$_KBF, ! No key buffer pointer (only if REL and KEY)
! RMS$_KEY, ! Record number 0 or > MRN (if KEY and REL)
! RMS$_LSN, ! LSN greater than 99999 (if LSN)
! RMS$_NEF, ! NRP not set at end-of-file (only if SEQ)
! RMS$_RBF, ! No record buffer pointer
! RMS$_RSZ, ! RSZ greater than MRS or not equal to MRS
! ! and RFM is FIX
! RMS$_SEQ, ! Key in $PUT SEQ less than key on prior
! ! $PUT SEQ
! RMS$_REX, ! Record already exists in target record cell
! RMS$_RLK]: ! Record locked by another task
[OTHERWISE]: DO_RETURN (HORRIBLE);
tes;
! TTY_PUT_QUO ('DAP: Leaving RWRITE'); TTY_PUT_CRLF ();
DO_RETURN (RWR$OK);
END; ! RWRITE
%sbttl 'RCLOSE: Close a remote file (12)'
GLOBAL ROUTINE RCLOSE (fnumber, option): FORTRAN_FUNC =
!++
! FUNCTIONAL DESCRIPTION:
! Close a file opened by ROPEN.
!
! FORMAL PARAMETERS:
! fnumber File number, assigned by ROPEN.
! option Close option:
! O_NOTHING to do nothing,
! O_SUBMIT to submit the file for remote batch
! processing,
! O_PRINT to submit the file for remote printing,
! O_DELETE to delete the remote file,
! O_SUB_DEL to submit the file and then delete it (not
! implemented yet on some systems), or
! O_PRINT_DEL to print the file and then delete it
! (not implemented yet on some systems).
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! RCL$WRONG_TYPE if an argument is of the wrong type or is invalid.
! The close option may have an undefined value, or the file
! number may be incorrect or refer to a file which is
! not open.
! RCL$OK if the operation succeeded.
! RCL$NO_NETWORK if the network operation could not be done
! (RMS$_CON, RMS$_DPE, RMS$_NLB, RMS$_SUP).
! RCL$CHECKSUM if there was a checksum error (RMS$_CRC).
! HORRIBLE if some other error occurred.
!
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!
!--
BEGIN ! RCLOSE
BIND ![52]
a_fnumber = (dixadr (.fnumber)), ![52]
a_option = (dixadr (.option)); ![52]
! TTY_PUT_QUO ('DAP: Entering RCLOSE'); TTY_PUT_CRLF ();
! Check parameters.
if (.a_option lss O_MIN) or (.a_option gtr O_MAX) ![52]
then DO_RETURN (RCL$WRONG_TYPE);
if (.a_fnumber lss 0) or (.a_fnumber geq MAXFILES) ![52]
then DO_RETURN (RCL$WRONG_TYPE);
if not .file_status [.a_fnumber, in_use] ![52]
then DO_RETURN (RCL$WRONG_TYPE);
! Put close options into the FOP.
case .a_option from O_MIN to O_MAX of ![52]
SET
[O_NOTHING]: ; ! Nothing
[O_SUBMIT]: ! Submit
$FAB_STORE (FAB = fabs [.a_fnumber, $], FOP = SCF); ![52]
[O_PRINT]: ! Print
$FAB_STORE (FAB = fabs [.a_fnumber, $], FOP = SPL); ![52]
[O_3]: ; ! Nothing
[O_DELETE]: ! Delete
$FAB_STORE (FAB = fabs [.a_fnumber, $], FOP = DLT); ![52]
[O_SUB_DEL]: begin ! Submit and delete
$FAB_STORE (FAB = fabs [.a_fnumber, $], FOP = SCF); ![52]
$FAB_STORE (FAB = fabs [.a_fnumber, $], FOP = DLT); ![52]
end;
[O_PRINT_DEL]: begin ! Print and delete
$FAB_STORE (FAB = fabs [.a_fnumber, $], FOP = SPL); ![52]
$FAB_STORE (FAB = fabs [.a_fnumber, $], FOP = DLT); ![52]
end;
TES;
! Need to set FAB fields:
! FOP File-processing options (NAM, SCF, DLT, or SPL)
! IFI Internal file identifier (gets zeroed)
! NAM Name block address (used only if NAM is set in FOP)
! XAB Extended attribute block address
! Sets STS to completion status, STV to status value
R$CLOSE (fabs [.a_fnumber, $], DAPERR); ![52]
selectone .fabs [.a_fnumber, FAB$H_STS] of ![52]
set
[RMS$_NORMAL]: ; ! Operation successful
[RMS$_CON, ! Can't connect to FAL
RMS$_DPE, ! DAP protocol error
RMS$_NLB, ! Network link broken
RMS$_SUP]: ! Operation not supported on remote system
DO_RETURN (RCL$NO_NETWORK);
! [RMS$_OK_REO, ! File should be reorganized
! RMS$_CCF, ! Cannot close file
! RMS$_EDQ, ! Cannot unlock file
! RMS$_IFI, ! Bad IFI value (file not open?)
! RMS$_PRV]: ! File protection violation
[OTHERWISE]: DO_RETURN (HORRIBLE);
tes;
file_status [.a_fnumber, in_use] = FALSE; ![52]
! TTY_PUT_QUO ('DAP: Leaving RCLOSE'); TTY_PUT_CRLF ();
DO_RETURN (RCL$OK);
END; ! RCLOSE
%sbttl 'RDEL: Delete a remote file (13)'
GLOBAL ROUTINE RDEL (fname, userid, passwd, acct): FORTRAN_FUNC =
!++
! FUNCTIONAL DESCRIPTION:
! Delete a file. Only closed files may be deleted.
!
! FORMAL PARAMETERS:
! fname File name, including node name, in ASCII.
! userid USERID_SIZE ASCII character user code.
! passwd PASSWD_SIZE ASCII character password.
! acct ACCT_SIZE ASCII character account.
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! RDE$WRONG_TYPE if an argument is of the wrong type or is invalid
! (RMS$_FSI).
! RDE$OK if the operation succeeded.
! RDE$NO_NETWORK if the network operation could not be done
! (RMS$_CON, RMS$_DPE, RMS$_NLB, RMS$_SUP).
! RDE$CHECKSUM if there was a checksum error (RMS$_CRC).
! RDE$NO_FILE if the file does not exist or is not available
! (RMS$_FLK, RMS$_FNF, RMS$_PRV).
! HORRIBLE if some other error occurred.
!
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!
!--
BEGIN ! RDEL
LOCAL
error_code;
MAP
fname: SCS_ARG,
userid: SCS_ARG,
passwd: SCS_ARG,
acct: SCS_ARG;
BIND
a_fname = GET_STRING (fname),
a_userid = GET_STRING (userid),
a_passwd = GET_STRING (passwd),
a_acct = GET_STRING (acct);
! TTY_PUT_QUO ('DAP: Entering RDEL'); TTY_PUT_CRLF ();
![7] Check byte strings for ASCII in RDEL.
FORCE_ASCII (fname, RDE$WRONG_TYPE); ![7]
FORCE_ASCII (userid, RDE$WRONG_TYPE); ![7]
FORCE_ASCII (passwd, RDE$WRONG_TYPE); ![7]
FORCE_ASCII (acct, RDE$WRONG_TYPE); ![7]
! Construct embedded file specification.
CONSTRUCT_FILESPEC (a_fname, a_userid, a_passwd, a_acct,
wholespeca);
! Construct FAB.
! FAB input fields:
! FNA File specification string address
! FOP File-processing options (NAM bit only)
! IFI Internal file identifier (must be zero)
! NAM NAM block address
! FAB output fields:
! STS Completion status code
! STV Status value
! NAM block input fields:
! DVI Device identification (if NAM set in FOP)
! ESA Expanded string area address
! ESS Expanded string area size
! RLF Related file NAM block address (if NAM set in FOP)
! RSA Resultant string area address
! RSS Resultant string area size
! NAM block output fields:
! DVI Device identification
! ESL Expanded string length
! FNB Filename status bits
! RSL Resultant string length
$FAB_INIT (FAB = afab, FNA = CH$PTR (wholespeca), FAC = DEL);
R$ERASE (afab, DAPERR);
error_code = 0;
selectone .afab [FAB$H_STS] of
set
[RMS$_NORMAL]: ; ! Operation successful
[RMS$_FLK, ! Invalid simultaneous access
RMS$_FNF, ! File not found
RMS$_PRV]: ! File protection violation
error_code = (RDE$NO_FILE);
[RMS$_FSI]: ! File spec contains invalid syntax
error_code = (RDE$WRONG_TYPE);
[RMS$_CON, ! Can't connect to FAL
RMS$_DPE, ! DAP protocol error
RMS$_NLB, ! Network link broken
RMS$_SUP]: ! Operation not supported on remote system
error_code = (RDE$NO_NETWORK);
! [RMS$_CEF, ! Cannot erase file
! RMS$_CGJ, ! Cannot get JFN for file
! RMS$_FNC]: ! File is not closed
! [OTHERWISE]: error_code = (HORRIBLE);
tes;
IF .error_code NEQ 0
THEN
BEGIN
R$CLOSE (afab, DAPERR); !if error on OPEN, close link
DO_RETURN (.error_code);
END;
! TTY_PUT_QUO ('DAP: Leaving RDEL'); TTY_PUT_CRLF ();
DO_RETURN (RDE$OK);
END; ! RDEL
%sbttl 'RSUB: Submit a remote file for batch processing (14)'
GLOBAL ROUTINE RSUB (fname, userid, passwd, acct): FORTRAN_FUNC =
!++
! FUNCTIONAL DESCRIPTION:
! Submit a remote file for batch processing.
!
! FORMAL PARAMETERS:
! fname File name, including node name, in ASCII.
! userid USERID_SIZE ASCII character user code.
! passwd PASSWD_SIZE ASCII character password.
! acct ACCT_SIZE ASCII character account.
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! RSU$WRONG_TYPE if an argument is of the wrong type or is
! invalid (RMS$_FSI).
! RSU$OK if the operation succeeded.
! RSU$NO_NETWORK if the network operation could not be done
! (RMS$_CON, RMS$_DPE, RMS$_NLB, RMS$_SUP).
! RSU$CHECKSUM if there was a checksum error (RMS$_CRC).
! RSU$NO_FILE if the file does not exist or is not available
! (RMS$_FNF, RMS$_PRV).
! HORRIBLE if some other error occurred.
!
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!
!--
BEGIN ! RSUB
LOCAL
error_code;
MAP
fname: SCS_ARG,
userid: SCS_ARG,
passwd: SCS_ARG,
acct: SCS_ARG;
BIND
a_fname = GET_STRING (fname),
a_userid = GET_STRING (userid),
a_passwd = GET_STRING (passwd),
a_acct = GET_STRING (acct);
! TTY_PUT_QUO ('DAP: Entering RSUB'); TTY_PUT_CRLF ();
![7] Check byte pointers for ASCII in RSUB.
FORCE_ASCII (fname, RSU$WRONG_TYPE); ![7]
FORCE_ASCII (userid, RSU$WRONG_TYPE); ![7]
FORCE_ASCII (passwd, RSU$WRONG_TYPE); ![7]
FORCE_ASCII (acct, RSU$WRONG_TYPE); ![7]
! Construct embedded file specification.
CONSTRUCT_FILESPEC (a_fname, a_userid, a_passwd, a_acct,
wholespeca);
! Construct the FAB.
$FAB_INIT (FAB = afab, FNA = CH$PTR (wholespeca));
! Ensure treatment as a remote file.
afab [FAB$V_DEV_REMOTE] = TRUE;
R$OPEN (afab, DAPERR);
error_code = 0;
selectone .afab [FAB$H_STS] of
set
[RMS$_NORMAL]: ; ! Operation successful
[RMS$_FNF, ! File not found
RMS$_PRV]: ! File protection violation
error_code = (RSU$NO_FILE);
[RMS$_FSI]: ! File spec contains invalid syntax
error_code = (RSU$WRONG_TYPE);
[RMS$_CON, ! Can't connect to FAL
RMS$_DPE, ! DAP protocol error
RMS$_NLB, ! Network link broken
RMS$_SUP]: ! Operation not supported on remote system
error_code = (RSU$NO_NETWORK);
! [RMS$_AID, ! Area XABs are not ascending by AID field value
! RMS$_BKZ, ! BKZ in area XAB greater than 31
! RMS$_BLN, ! FAB on entry in XAB chain has bad BLN
! RMS$_CGJ, ! Cannot get JFN on file
! RMS$_COD, ! Entry in XAB chain has bad COD
! RMS$_COF, ! Cannot open file
! RMS$_DAN, ! DAN in KEY XAB greater than highest AID
! RMS$_DEV, ! Device is not disk
! RMS$_DTP, ! DTP in KEY XAB invalid or disagrees with
! ! BSZ of FAB
! RMS$_FEX, ! File already exists
! RMS$_FLK, ! File locked
! RMS$_IAN, ! IAN in KEY XAB greater than highest AID
! RMS$_IMX, ! Multiple copies of DATE or SUMMARY XAB
! RMS$_ORD, ! KEY XABs not in ascending order by REF field
! ! or AREA XABs not in ascending order by AID
! RMS$_RAT, ! BLK specified for stream file
! RMS$_REF, ! KEY XABs are not ascending by REF field value
! RMS$_SIZ]: ! Number of bytes in data key exceeds 255
[OTHERWISE]: error_code = (HORRIBLE);
tes;
IF .error_code NEQ 0
THEN
BEGIN
R$CLOSE (afab, DAPERR); !if error on OPEN, close link
DO_RETURN (.error_code);
END;
! Close file for submission.
$FAB_STORE (FAB = afab, FOP = SCF);
R$CLOSE (afab, DAPERR);
selectone .afab [FAB$H_STS] of
set
[RMS$_NORMAL]: ; ! Operation successful
[RMS$_PRV]: ! File protection violation
DO_RETURN (RSU$NO_FILE);
[RMS$_CON, ! Can't connect to FAL
RMS$_DPE, ! DAP protocol error
RMS$_NLB, ! Network link broken
RMS$_SUP]: ! Operation not supported on remote system
DO_RETURN (RSU$NO_NETWORK);
! [RMS$_OK_REO, ! File should be reorganized
! RMS$_CCF, ! Cannot close file
! RMS$_EDQ, ! Cannot unlock file
! RMS$_IFI]: ! Bad IFI value (file not open?)
[OTHERWISE]: DO_RETURN (HORRIBLE);
tes;
! TTY_PUT_QUO ('DAP: Leaving RSUB'); TTY_PUT_CRLF ();
DO_RETURN (RSU$OK);
END; ! RSUB
%sbttl 'RRENM: Rename a remote file (19)'
GLOBAL ROUTINE RRENM (cfname, nfname, userid, passwd, acct): FORTRAN_FUNC =
!++
! FUNCTIONAL DESCRIPTION:
! Rename a file. The file must be closed.
!
! FORMAL PARAMETERS:
! cfname Current file name, including node name, in ASCII.
! nfname New file name, in ASCII.
! userid USERID_SIZE ASCII character user code.
! passwd PASSWD_SIZE ASCII character password.
! acct ACCT_SIZE ASCII character account.
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! RRN$WRONG_TYPE if an argument is of the wrong type or is
! invalid.
! RRN$OK if the operation succeeded.
! RRN$NO_NETWORK if the network operation could not be done
! (RMS$_CON, RMS$_DPE, RMS$_NLB, RMS$_SUP).
! RRN$CHECKSUM if there was a checksum error (RMS$_CRC).
! RRN$NO_FILE if the file does not exist or is not available
! (RMS$_FEX, RMS$_FNF, RMS$_PRV).
! HORRIBLE if some other error occurred.
!
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!
!--
BEGIN ! RRENM
MAP
cfname: SCS_ARG,
nfname: SCS_ARG,
userid: SCS_ARG,
passwd: SCS_ARG,
acct: SCS_ARG;
BIND
a_cfname = GET_STRING (cfname),
a_nfname = GET_STRING (nfname),
a_userid = GET_STRING (userid),
a_passwd = GET_STRING (passwd),
a_acct = GET_STRING (acct);
! TTY_PUT_QUO ('DAP: Entering RRENM'); TTY_PUT_CRLF ();
! Caveat: This code has not been tested!
! Also, remote rename is not supported by most FALs.
![7] Check byte pointers for ASCII in RRENM.
FORCE_ASCII (cfname, RRN$WRONG_TYPE); ![7]
FORCE_ASCII (nfname, RRN$WRONG_TYPE); ![7]
FORCE_ASCII (userid, RRN$WRONG_TYPE); ![7]
FORCE_ASCII (passwd, RRN$WRONG_TYPE); ![7]
FORCE_ASCII (acct, RRN$WRONG_TYPE); ![7]
! Construct embedded file specifications.
CONSTRUCT_FILESPEC (a_cfname, a_userid, a_passwd, a_acct, wholespeca);
CONSTRUCT_FILESPEC (a_nfname, a_userid, a_passwd, a_acct, wholespecd);
! Construct source and destination FABs.
! FAB input fields:
! FNA File specification string address
! IFI Internal file identifier (must be zero)
! NAM NAM block address
! NAM input fields:
! ESA Expanded string area address (must be nonzero)
! ESS Expanded string area size (must be nonzero)
! RLF Related file NAM block address
! RSA Resultant string area address
! RSS Resultant string area size
! Related file NAM block fields:
! RSA Resultant string area address
! RSL Resultant string length
! Output in first FAB:
! STS Completion status code
! STV Status value
! Output in NAM blocks:
! DVI Device identification
! ESL Expanded string length
! FNB File name status bits
! RSL Resultant string length
! WCC Wildcard context
$FAB_INIT (FAB = afab, FNA = CH$PTR (wholespeca));
$FAB_INIT (FAB = dfab, FNA = CH$PTR (wholespecd));
! Ensure treatment as a remote file.
afab [FAB$V_DEV_REMOTE] = TRUE;
dfab [FAB$V_DEV_REMOTE] = TRUE;
R$RENAME (afab, dfab, DAPERR);
selectone .afab [FAB$H_STS] of
set
[RMS$_NORMAL]: ; ! Operation successful
[RMS$_FEX, ! File already exists; not superseded
RMS$_FNF, ! File not found
RMS$_PRV]: ! File protection violation
DO_RETURN (RRN$NO_FILE);
[RMS$_CON, ! Can't connect to FAL
RMS$_DPE, ! DAP protocol error
RMS$_NLB, ! Network link broken
RMS$_SUP]: ! Operation not supported on remote system
DO_RETURN (RRN$NO_NETWORK);
[OTHERWISE]: DO_RETURN (HORRIBLE);
tes;
! TTY_PUT_QUO ('DAP: Leaving RRENM'); TTY_PUT_CRLF ();
DO_RETURN (RRN$OK);
END; ! RRENM
%sbttl 'RDIRS: Set up to perform a remote directory listing (16A)'
GLOBAL ROUTINE RDIRS (fname, userid, passwd, acct): FORTRAN_FUNC =
!++
! FUNCTIONAL DESCRIPTION:
! Set up to read a directory of remote files.
!
! FORMAL PARAMETERS:
! fname File specification, including node name, in ASCII.
! userid USERID_SIZE ASCII character user code.
! passwd PASSWD_SIZE ASCII character password.
! acct ACCT_SIZE ASCII character account.
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! RDS$WRONG_TYPE if an argument is of the wrong type or is
! invalid.
! RDS$OK if the operation succeeded.
! RDS$NO_NETWORK if the network operation could not be done
! (RMS$_CON, RMS$_DPE, RMS$_NLB, RMS$_SUP).
! RDS$CHECKSUM if there was a checksum error (RMS$_CRC).
! RDS$NO_FILE if the directory does not exist or is not available.
! HORRIBLE if some other error occurred.
!
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!
!--
BEGIN ! RDIRS
MAP
fname: SCS_ARG,
userid: SCS_ARG,
passwd: SCS_ARG,
acct: SCS_ARG;
BIND
a_fname = GET_STRING (fname),
a_userid = GET_STRING (userid),
a_passwd = GET_STRING (passwd),
a_acct = GET_STRING (acct);
! TTY_PUT_QUO ('DAP: Entering RDIRS'); TTY_PUT_CRLF ();
! Caveat: This code has not been tested!
![7] Check byte pointers for ASCII in RDIRS.
FORCE_ASCII (fname, RDS$WRONG_TYPE); ![7]
FORCE_ASCII (userid, RDS$WRONG_TYPE); ![7]
FORCE_ASCII (passwd, RDS$WRONG_TYPE); ![7]
FORCE_ASCII (acct, RDS$WRONG_TYPE); ![7]
! Construct embedded file specification.
CONSTRUCT_FILESPEC (a_fname, a_userid, a_passwd, a_acct, dirspec);
! Construct wild FAB.
$FAB_INIT (FAB = dirfab, FNA = CH$PTR (dirspec));
! Ensure treatment as a remote file.
dirfab [FAB$V_DEV_REMOTE] = TRUE;
R$DIRECTORY (dirfab, DAPERR);
selectone .dirfab [FAB$H_STS] of
set
[RMS$_NORMAL]: ; ! Operation successful
[RMS$_CON, ! Can't connect to FAL
RMS$_DPE, ! DAP protocol error
RMS$_NLB, ! Network link broken
RMS$_SUP]: ! Operation not supported on remote system
DO_RETURN (RDS$NO_NETWORK);
[OTHERWISE]: DO_RETURN (HORRIBLE);
tes;
! TTY_PUT_QUO ('DAP: Leaving RDIRS'); TTY_PUT_CRLF ();
DO_RETURN (RDS$OK);
END; ! RDIRS
%sbttl 'RDIR: Perform a remote directory listing (16B)'
GLOBAL ROUTINE RDIR (length, data): FORTRAN_FUNC =
!++
! FUNCTIONAL DESCRIPTION:
! Get one entry of a remote file directory set up by RDIRS.
!
! FORMAL PARAMETERS:
! length Maximum length of directory data to be returned,
! returned as the actual length.
! data Returned ASCII directory information.
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! RDR$WRONG_TYPE if an argument is of the wrong type or is
! invalid.
! RDR$OK if the operation succeeded.
! RDR$NO_NETWORK if the network operation could not be done
! (RMS$_CON, RMS$_DPE, RMS$_NLB, RMS$_SUP).
! RDR$NO_MORE if there are no more directory entries to return
! without another call to RDIRS (RMS$_NMF).
! RDR$NO_FILE if a file does not exist or is not available
! (RMS$_FNF, RMS$_PRV).
! HORRIBLE if some other error occurred.
!
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!
!--
BEGIN ! RDIR
MAP
data: SCS_ARG;
BIND
a_length = (dixadr (.length)), ![52]
a_data = GET_STRING (data);
! TTY_PUT_QUO ('DAP: Entering RDIR'); TTY_PUT_CRLF ();
! Caveat: This code has not been tested!
![7] Check that byte pointers are ASCII in RDIR.
FORCE_ASCII (data, RDR$WRONG_TYPE); ![7]
! Required FAB fields:
! IFI Internal file identifier (must be zero)
! NAM Name block address
! Required NAM fields:
! DVI Device identification of device containing directory to be searched
! ESA Expanded string area address
! ESL Expanded string length
! FNB File name status bits (wildcard bits only)
! RSA Resultant string area address
! RSL Resultant string area length
! RSS Resultant string area size
! WCC Wildcard context
! FAB output fields:
! STS Completion status code
! STV Status value
! NAM output fields:
! RSL Resultant string length
! WCC Wildcard context
R$SEARCH (dirfab, DAPERR);
selectone .dirfab [FAB$H_STS] of
set
[RMS$_NORMAL]: ; ! Operation successful
[RMS$_FNF, ! File not found
RMS$_PRV]: ! File protection violation
DO_RETURN (RDR$NO_FILE);
[RMS$_CON, ! Can't connect to FAL
RMS$_DPE, ! DAP protocol error
RMS$_NLB, ! Network link broken
RMS$_SUP]: ! Operation not supported on remote system
DO_RETURN (RDR$NO_NETWORK);
[RMS$_NMF]: ! No more files
DO_RETURN (RDR$NO_MORE);
[OTHERWISE]: DO_RETURN (HORRIBLE);
tes;
! Updated FAB.
! Call R$LIST to get directory listing.
R$LIST (dirfab, a_data, .a_length, 3, DAPERR); ![52]
selectone .dirfab [FAB$H_STS] of
set
[RMS$_NORMAL]: ; ! Operation successful
[RMS$_FNF, ! File not found
RMS$_PRV]: ! File protection violation
DO_RETURN (RDR$NO_FILE);
[RMS$_CON, ! Can't connect to FAL
RMS$_DPE, ! DAP protocol error
RMS$_NLB, ! Network link broken
RMS$_SUP]: ! Operation not supported on remote system
DO_RETURN (RDR$NO_NETWORK);
[RMS$_NMF]: ! No more files
DO_RETURN (RDR$NO_MORE);
[OTHERWISE]: DO_RETURN (HORRIBLE);
tes;
! TTY_PUT_QUO ('DAP: Leaving RDIR'); TTY_PUT_CRLF ();
DO_RETURN (RDR$OK);
END; ! RDIR
%sbttl 'RPRINT: Print a remote file (15)'
GLOBAL ROUTINE RPRINT (fname, userid, passwd, acct): FORTRAN_FUNC =
!++
! FUNCTIONAL DESCRIPTION:
! Print a remote file at the remote node.
!
! FORMAL PARAMETERS:
! fname File specification, including node name, in ASCII.
! userid USERID_SIZE ASCII character user code.
! passwd PASSWD_SIZE ASCII character password.
! acct ACCT_SIZE ASCII character account.
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! RPR$WRONG_TYPE if an argument is of the wrong type or is invalid
! (RMS$_FSI).
! RPR$OK if the operation succeeded.
! RPR$NO_NETWORK if the network operation could not be done
! (RMS$_CON, RMS$_DPE, RMS$_NLB, RMS$_SUP).
! RPR$CHECKSUM if there was a checksum error (RMS$_CRC).
! RPR$NO_FILE if the file does not exist or is not available
! (RMS$_FEX, RMS$_FLK, RMS$_FNF, RMS$_PRV).
! HORRIBLE if some other error occurred.
!
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!
!--
BEGIN ! RPRINT
LOCAL
error_code;
MAP
fname: SCS_ARG,
userid: SCS_ARG,
passwd: SCS_ARG,
acct: SCS_ARG;
BIND
a_fname = GET_STRING (fname),
a_userid = GET_STRING (userid),
a_passwd = GET_STRING (passwd),
a_acct = GET_STRING (acct);
! TTY_PUT_QUO ('DAP: Entering RPRINT'); TTY_PUT_CRLF ();
![7] Check that byte pointers are ASCII in RPRINT.
FORCE_ASCII (fname, RPR$WRONG_TYPE); ![7]
FORCE_ASCII (userid, RPR$WRONG_TYPE); ![7]
FORCE_ASCII (passwd, RPR$WRONG_TYPE); ![7]
FORCE_ASCII (acct, RPR$WRONG_TYPE); ![7]
! Construct embedded file specification.
CONSTRUCT_FILESPEC (a_fname, a_userid, a_passwd, a_acct, wholespeca);
! Construct FAB.
$FAB_INIT (FAB = afab, FNA = CH$PTR (wholespeca));
! Ensure treatment as a remote file.
afab [FAB$V_DEV_REMOTE] = TRUE;
! Open remote file.
R$OPEN (afab, DAPERR);
error_code = 0;
selectone .afab [FAB$H_STS] of
set
[RMS$_NORMAL]: ; ! Operation successful
[RMS$_FEX, ! File already exists
RMS$_FLK, ! File locked
RMS$_FNF, ! File not found
RMS$_PRV]: ! File protection violation
error_code = (RPR$NO_FILE);
[RMS$_FSI]: ! File spec contains invalid syntax
error_code = (RPR$WRONG_TYPE);
[RMS$_CON, ! Can't connect to FAL
RMS$_DPE, ! DAP protocol error
RMS$_NLB, ! Network link broken
RMS$_SUP]: ! Operation not supported on remote system
error_code = (RPR$NO_NETWORK);
! [RMS$_AID, ! Area XABs not in ascending order by AID
! RMS$_BKZ, ! BKZ in AREA XAB greater than 31
! RMS$_BLN, ! FAB on entry in XAB chain has bad BLN
! RMS$_CGJ, ! Cannot get JFN on file
! RMS$_COD, ! Entry in XAB chain has bad COD
! RMS$_COF, ! Cannot open file
! RMS$_DAN, ! DAN in KEY XAB greater than highest AID
! RMS$_DEV, ! Device is not disk
! RMS$_DTP, ! DTP in KEY XAB invalid or disagrees with
! ! BSZ of FAB
! RMS$_IAN, ! IAN in KEY XAB greater than highest AID
! RMS$_IMX, ! Multiple copies of DATE or SUMMARY XAB
! RMS$_ORD, ! KEY XABs not in ascending order by REF field
! ! or AREA XABs not in ascending order by AID
! RMS$_RAT, ! BLK specified for stream file
! RMS$_REF, ! KEY XABs are not ascending by REF field value
! RMS$_SIZ]: ! Number of bytes in data key exceeds 255
[OTHERWISE]: error_code = (HORRIBLE);
tes;
IF .error_code NEQ 0
THEN
BEGIN
R$CLOSE (afab, DAPERR); !if error on OPEN, close link
DO_RETURN (.error_code);
END;
! Set up SPL bit in FOP.
$FAB_STORE (FAB = afab, FOP = SPL);
! Close for printing.
R$CLOSE (afab, DAPERR);
selectone .afab [FAB$H_STS] of
set
[RMS$_NORMAL]: ; ! Operation successful
[RMS$_PRV]: ! File protection violation
DO_RETURN (RPR$NO_FILE);
[RMS$_CON, ! Can't connect to FAL
RMS$_DPE, ! DAP protocol error
RMS$_NLB, ! Network link borken
RMS$_SUP]: ! Operation not supported by remote system
DO_RETURN (RPR$NO_NETWORK);
! [RMS$_OK_REO, ! File should be reorganized
! RMS$_CCF, ! Cannot close file
! RMS$_EDQ, ! Cannot unlock file
! RMS$_IFI]: ! Bad IFI value (file not open?)
[OTHERWISE]: DO_RETURN (HORRIBLE);
tes;
! TTY_PUT_QUO ('DAP: Leaving RPRINT'); TTY_PUT_CRLF ();
DO_RETURN (RPR$OK);
END; ! RPRINT
%sbttl 'DAPERR: Error routine for DAP interface errors'
ROUTINE DAPERR (operation, theblock): RMS$ERCAL NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
! Handle errors from the DAP interface routines.
!
! FORMAL PARAMETERS:
! operation operation which failed
! theblock pointer to the failing block
! (status code is always in the same place)
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! None
!
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! TBS
!
!--
BEGIN ! DAPERR
MAP
theblock: REF $FAB_DECL; ! FAB or RAB; doesn't matter which,
! since the status code is in the same
! place.
! TTY_PUT_QUO ('DAP: Entering DAPERR'); TTY_PUT_CRLF ();
! TTY_PUT_QUO ('DAP: DAPERR error is ');
! TTY_PUT_INTEGER (.theblock [FAB$H_STS], 8, 8);
! TTY_PUT_CRLF ();
! TTY_PUT_QUO ('DAP: Leaving DAPERR'); TTY_PUT_CRLF ();
END; ! DAPERR
%sbttl 'CONSTRUCT_FILESPEC: Construct embedded file specification'
ROUTINE CONSTRUCT_FILESPEC (fname, userid, passwd, acct, result): NOVALUE =
!++
! FUNCTIONAL DESCRIPTION:
! Construct an embedded file specification.
!
! FORMAL PARAMETERS:
! fname: Byte pointer to FSPEC_SIZE ASCII file name,
! including node name.
! userid: Byte pointer to USERID_SIZE ASCII character
! userid.
! passwd: Byte pointer to PASSWD_SIZE character ASCII
! password.
! acct: Byte pointer to ACCT_SIZE ASCII character
! account.
! result: Address of where to place resulting string.
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! None
!
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! TBS
!
!--
BEGIN ! CONSTRUCT_FILESPEC
LOCAL
indexs, ! Source index pointer
indexr, ! Result index pointer
node_flag, ! TRUE if there was a node name in the file name
char, ! A character
count; ! Count of significant characters in a string
! TTY_PUT_QUO ('DAP: Entering CONSTRUCT_FILESPEC'); TTY_PUT_CRLF ();
indexr = CH$PTR (.result);
node_flag = TRUE;
indexs = .fname;
incr i from 0 to FSPEC_SIZE - 1 do ! Look for node name
if ((char = CH$RCHAR_A (indexs)) eql %C':')
then exitloop ! Found a colon
else if (.char eql 0) or (.char eql %C' ') or (.i eql FSPEC_SIZE - 1)
then begin ! End of string
! TTY_PUT_QUO ('DAP: C_S no nodename'); TTY_PUT_CRLF ();
node_flag = FALSE;
indexs = .fname;
exitloop;
end;
if .node_flag eql TRUE ! May be node name
then if CH$RCHAR_A (indexs) eql %C':' ! Another colon?
then begin ! Node name
! TTY_PUT_QUO ('DAP: C_S move node name'); TTY_PUT_CRLF ();
CH$MOVE (CH$DIFF (.indexs, .fname) - 2, .fname, .indexr);
indexr = CH$PLUS (.indexr, CH$DIFF (.indexs, .fname) - 2);
end
else begin ! Device name
indexs = .fname;
node_flag = FALSE;
! TTY_PUT_QUO ('DAP: C_S no node name but colon'); TTY_PUT_CRLF ();
indexr = CH$PTR (.result);
end;
if (CH$RCHAR (.userid) neq %C' ') and (CH$RCHAR (.userid) neq 0)
then begin ! User id
! TTY_PUT_QUO ('DAP: C_S userid'); TTY_PUT_CRLF ();
CH$WCHAR_A (%C'"', indexr);
count = COUNTEM (.userid, USERID_SIZE);
CH$MOVE (.count, .userid, .indexr); ! Move userid
indexr = CH$PLUS (.indexr, .count);
if (CH$RCHAR (.passwd) neq %C' ') and (CH$RCHAR (.passwd) neq 0)
then begin ! Password
! TTY_PUT_QUO ('DAP: C_S password'); TTY_PUT_CRLF ();
CH$WCHAR_A (%C' ', indexr);
count = COUNTEM (.passwd, PASSWD_SIZE);
CH$MOVE (.count, .passwd, .indexr); ! Move password
indexr = CH$PLUS (.indexr, .count);
if (CH$RCHAR (.acct) neq %C' ') and (CH$RCHAR (.acct) neq 0)
then begin ! Account
! TTY_PUT_QUO ('DAP: C_S account'); TTY_PUT_CRLF ();
CH$WCHAR_A (%C' ', indexr);
count = COUNTEM (.acct, ACCT_SIZE);
CH$MOVE (.count, .acct, .indexr); ! Move account
indexr = CH$PLUS (.indexr, .count);
end;
end;
CH$WCHAR_A (%C'"', indexr); ! Quote after access
end;
![42] In CONSTRUCT_FILESPEC, always insert a double colon after the optional
![42] embedded access information in the file speciifcation being created.
![42] This will allow the DAP code to properly handle a missing (default)
![42] nodename.
![42]if .node_flag eql TRUE ! Need colons
![42] then begin
! TTY_PUT_QUO ('DAP: C_S double colon'); TTY_PUT_CRLF ();
CH$WCHAR_A (%C':', indexr);
CH$WCHAR_A (%C':', indexr);
![42] end;
! Collect up the rest of the filespec.
! TTY_PUT_QUO ('DAP: C_S rest of filespec'); TTY_PUT_CRLF ();
! TTY_PUT_QUO ('DAP: C_S length is ');
count = COUNTEM (.indexs, FSPEC_SIZE - CH$DIFF (.indexs, .fname));
! TTY_PUT_INTEGER (.count, 10, 10);
! TTY_PUT_CRLF ();
CH$MOVE (.count, .indexs, .indexr); ! Move remaining
indexr = CH$PLUS (.indexr, .count);
! Make the file name string ASCIZ.
CH$WCHAR_A (0, indexr); ! Add a null
! TTY_PUT_QUO ('DAP: CONSTRUCT_FILESPEC made ');
! TTY_PUT_MSG (.result, WHOLESPEC_SIZE); TTY_PUT_CRLF ();
! TTY_PUT_QUO ('DAP: Leaving CONSTRUCT_FILESPEC'); TTY_PUT_CRLF ();
END; ! CONSTRUCT_FILESPEC
%sbttl 'COUNTEM: Count significant characters in a string'
ROUTINE COUNTEM (string, length) =
!++
! FUNCTIONAL DESCRIPTION:
! Count the significant (nonblank, nonnull) characters in a
! left-justified string and return the count.
!
! FORMAL PARAMETERS:
! string Byte pointer to the ASCII string
! length Maximum length of the string
!
! IMPLICIT INPUTS:
! None
!
! IMPLICIT OUTPUTS:
! None
!
! ROUTINE VALUE:
! The number of sigificant characters in the string.
!
! COMPLETION CODES:
! None
!
! SIDE EFFECTS:
! None
!
!--
BEGIN ! COUNTEM
LOCAL
char,
ptr;
ptr = .string;
incr counter from 0 to .length - 1 do
if ((char = CH$RCHAR_A (ptr)) eql %C' ') or (.char eql 0)
then return .counter;
return .length;
END; ! COUNTEM
END
ELUDOM