/*+                     

TITLE:	    	MDM_OPENF
    	    	Module containing MDMLIB file manipulation routines

VERSION:    	V1.1-002

FACILITY:   	MDMLIB

ABSTRACT:   	This module contains simple RMS interface routines.

ENVIRONMENT:	User mode, AST reentrant
                  
AUTHOR:	    	M. Madison
    	    	COPYRIGHT © 1988, RENSSELAER POLYTECHNIC INSTITUTE.
    	    	    	    	  All rights reserved.

MODIFICATION HISTORY:

    09-JUN-1987	    V1.0-001	Madison	    Initial coding.
    05-FEB-1988	    V1.1-002	Madison	    Consolidated routines and
    	    	    	    	    	    brought them up to doc specs.
                                               
-*/

%INCLUDE _MDMDEF;
%INCLUDE VMS_TYPES;
%INCLUDE $RMSDEF;                     
%INCLUDE $FABDEF;
%INCLUDE $RABDEF;
%INCLUDE $NAMDEF;
%INCLUDE LIB$GET_VM;
%INCLUDE LIB$FREE_VM;
%INCLUDE SYS$OPEN;
%INCLUDE SYS$CREATE;
%INCLUDE SYS$CONNECT;
%INCLUDE SYS$REWIND;
%INCLUDE SYS$GET;
%INCLUDE SYS$PUT;
%INCLUDE SYS$CLOSE;

    DECLARE LIB$ANALYZE_SDESC ENTRY (POINTER VALUE, FIXED BINARY(15),
    	    	POINTER) RETURNS (VMS_COND_VALUE),
    	    LIB$SCOPY_R_DX ENTRY (FIXED BINARY(15), ANY, POINTER VALUE)
    	    	RETURNS (VMS_COND_VALUE);


%DECLARE FBLK_SIZE FIXED;
%FBLK_SIZE = RAB$C_BLN + FAB$C_BLN + NAM$C_BLN + 12 + 255;

    DECLARE 1 FBLK UNION BASED,
    	    	2 FBLK_OVERLAY (FBLK_SIZE) VMS_BYTE_UNSIGNED,
    	    	2 FBLK_STRUC,
    	    	    3 FBLK_FILL1  	FIXED BINARY (31),
    	    	    3 FAB	    	LIKE FABDEF,
    	    	    3 FBLK_FILL2	FIXED BINARY(31),
    	    	    3 RAB	    	LIKE RABDEF,
    	    	    3 FBLK_FILL3    	FIXED BINARY (31),
    	    	    3 NAM   	    	LIKE NAMDEF,
    	    	    3 RSPEC_BUF	    	CHARACTER (255);

    DECLARE (NULL, ACTUALCOUNT, PRESENT) BUILTIN;


%PAGE;
MDM_OPENF: PROCEDURE (KEY, FSPEC, UNIT, DEFSPEC, RESSPEC)
    	    RETURNS (VMS_COND_VALUE)
    	    OPTIONS (IDENT ('V1.1-002'));
/*+

DESCRIPTION:	This procedure opens a sequential file for reading or
    	    	writing.

RETURNS:    	cond_value, longword (unsigned), write only, by value

PROTOTYPE:

    MDM_OPENF (key, fspec, unit [,defspec] [,resspec])

key:	 mask_longword, longword (unsigned), read only, by value
fspec:	 char_string, character string, read only, by descriptor
unit:	fblk, longword (unsigned), modify, by reference
defspec: char_string, character string, read only, by descriptor
resspec: char_string, character string, write only, by descriptor


COMPLETION CODES:   RMS$_NORMAL indicates normal successful completion.
    	    	    MDM__INVFUNC indicates invalid KEY value.
    	    	    MDM__INVFSPEC indicates invalid file specification.
    	    	    Other RMS error codes, or errors from LIB$ANALYZE_SDESC
    	    	    possible.

-*/

    DECLARE KEY FIXED BINARY (31) VALUE PARAMETER,
    	    (FSPEC, DEFSPEC, RESSPEC) POINTER VALUE PARAMETER,
    	    UNIT POINTER PARAMETER;

%INCLUDE $STSDEF;

    DECLARE (FSLEN, DFSLEN) FIXED BINARY(15),
    	    XDEFSPEC CHARACTER (4),
    	    JUNK FIXED BINARY(31);
                                       
/********************** BEGIN EXECUTABLE CODE *********************/

    IF KEY ^= MDM_M_READ & KEY ^= MDM_M_WRITE THEN RETURN (MDM__INVFUNC);
    STS$VALUE = LIB$GET_VM (FBLK_SIZE, UNIT,);
    IF ^STS$SUCCESS THEN RETURN (STS$VALUE);
    UNIT -> FBLK_OVERLAY = 0;

    UNIT -> RAB.RAB$B_BID = RAB$C_BID;
    UNIT -> RAB.RAB$B_BLN = RAB$C_BLN;
    UNIT -> RAB.RAB$L_FAB = ADDR (UNIT -> FAB);

    UNIT -> FAB.FAB$B_BID = FAB$C_BID;
    UNIT -> FAB.FAB$B_BLN = FAB$C_BLN;
    UNIT -> FAB.FAB$L_NAM = ADDR (UNIT -> NAM);

    UNIT -> NAM.NAM$B_BID = NAM$C_BID;
    UNIT -> NAM.NAM$B_BLN = NAM$C_BLN;
    POSINT (UNIT -> NAM.NAM$B_RSS) = SIZE (UNIT -> RSPEC_BUF);
    UNIT -> NAM.NAM$L_RSA = ADDR (UNIT -> RSPEC_BUF);

    STS$VALUE = LIB$ANALYZE_SDESC (FSPEC, FSLEN, UNIT -> FAB.FAB$L_FNA);
    IF ^STS$SUCCESS | FSLEN > 255 THEN DO;
    	STS$VALUE = LIB$FREE_VM (FBLK_SIZE, UNIT,);
    	RETURN(MDM__INVFSPEC);
    END;
    ELSE POSINT (UNIT -> FAB.FAB$B_FNS) = FSLEN;

    IF ACTUALCOUNT > 3 &: DEFSPEC ^= NULL THEN DO;
    	STS$VALUE = LIB$ANALYZE_SDESC (DEFSPEC, DFSLEN,
    	    UNIT -> FAB.FAB$L_DNA);
    	IF ^ STS$SUCCESS | DFSLEN > 255 THEN DO;
    	    JUNK = LIB$FREE_VM (FBLK_SIZE, UNIT,);
    	    RETURN (MDM__INVFSPEC);
    	END;
    	POSINT (UNIT -> FAB.FAB$B_DNS) = DFSLEN;
    END;
    ELSE DO;
    	XDEFSPEC = '.DAT';
    	UNIT -> FAB.FAB$L_DNA = ADDR (XDEFSPEC);
    	UNIT -> FAB.FAB$B_DNS = 4;
    END;

    IF KEY = MDM_M_READ THEN DO;
    	UNIT -> FAB.FAB$V_GET = '1'B;
    	UNIT -> FAB.FAB$V_TEF = '1'B;
    	UNIT -> FAB.FAB$V_SHRGET = '1'B;
    	UNIT -> RAB.RAB$V_RAH = '1'B;
    	STS$VALUE = SYS$OPEN (UNIT -> FAB,,);
    	IF STS$SUCCESS THEN DO;
    	    UNIT -> RAB.RAB$W_USZ = UNIT -> FAB.FAB$W_MRS;
    	    IF UNIT -> RAB.RAB$W_USZ = 0 THEN UNIT -> RAB.RAB$W_USZ = 32767;
    	    STS$VALUE = LIB$GET_VM (POSINT (UNIT -> RAB.RAB$W_USZ),
    	    	UNIT -> RAB.RAB$L_UBF,);
    	END;
    END;
    ELSE DO;
    	UNIT -> FAB.FAB$V_PUT = '1'B;
    	UNIT -> FAB.FAB$V_TEF = '1'B;
    	UNIT -> FAB.FAB$B_RFM = FAB$C_VAR;
    	UNIT -> FAB.FAB$W_MRS = 512;
    	UNIT -> FAB.FAB$V_CR = '1'B;
    	UNIT -> RAB.RAB$V_WBH = '1'B;
    	STS$VALUE = SYS$CREATE (UNIT -> FAB,,);
    END;

    IF ^STS$SUCCESS THEN DO;
    	JUNK = LIB$FREE_VM (FBLK_SIZE, UNIT,);
    	RETURN (STS$VALUE);
    END;                                               

    STS$VALUE = SYS$CONNECT (UNIT -> RAB,,);
    IF ^STS$SUCCESS THEN DO;
    	IF UNIT -> RAB.RAB$W_USZ ^= 0 THEN 
    	    JUNK = LIB$FREE_VM (POSINT (UNIT -> RAB.RAB$W_USZ),
    	    	UNIT -> RAB.RAB$L_UBF,);
      	JUNK = SYS$CLOSE (UNIT -> FAB,,);
    	JUNK = LIB$FREE_VM (FBLK_SIZE, UNIT,);
    END;

    IF STS$SUCCESS & ACTUALCOUNT > 4 &: RESSPEC ^= NULL THEN
    	JUNK = LIB$SCOPY_R_DX (POSINT (UNIT -> NAM.NAM$B_RSL),
    	    UNIT -> RSPEC_BUF, RESSPEC);

    RETURN(STS$VALUE);

END MDM_OPENF;
%PAGE;
MDM_CLOSEF: PROCEDURE (UNIT) RETURNS (VMS_COND_VALUE);
/*+

DESCRIPTION:	This procedure closes a file that was opened with
    	    	MDM_OPENF.

RETURNS:    	cond_value, longword (unsigned), write only, by value

PROTOTYPE:

    MDM_CLOSEF (unit)

unit:	fblk, longword (unsigned), modify, by reference

COMPLETION CODES:   RMS$_NORMAL indicates normal successful completion.

-*/

    DECLARE UNIT POINTER VALUE;

%INCLUDE $STSDEF;

    DECLARE JUNK FIXED BINARY(31);

/********************** BEGIN EXECUTABLE CODE *********************/

    STS$VALUE = SYS$CLOSE (UNIT -> FAB,,);
    IF UNIT -> RAB.RAB$W_USZ ^= 0 THEN 
    	JUNK = LIB$FREE_VM (POSINT (UNIT -> RAB.RAB$W_USZ),
    	    UNIT -> RAB.RAB$L_UBF,);
    JUNK = LIB$FREE_VM (FBLK_SIZE, UNIT,);
    RETURN (STS$VALUE);

END MDM_CLOSEF;
%PAGE;
MDM_READF: PROCEDURE (UNIT, LINE, LEN) RETURNS (VMS_COND_VALUE);
/*+

DESCRIPTION:	This procedure reads in a record from a sequential
    	    	file opened with MDM_OPENF.  The record is read into
    	    	an internal buffer allocated when the file was opened,
    	    	then copied into the user buffer (to easily handle
    	    	the many types of string descriptors).

RETURNS:    	cond_value, longword (unsigned), write only, by value

PROTOTYPE:

    MDM_READF (unit, line [,len])

unit:	fblk, longword (unsigned), modify, by reference
line:	char_string, character string, write only, by descriptor
len:	word_unsigned, word (unsigned), write only, by reference

COMPLETION CODES:   RMS$_NORMAL indicates normal successful completion.

-*/

    DECLARE (UNIT, LINE) POINTER VALUE PARAMETER,
    	    LEN FIXED BINARY(15) PARAMETER;

%INCLUDE $STSDEF;

    DECLARE JUNK VMS_COND_VALUE;

/********************** BEGIN EXECUTABLE CODE *********************/

    STS$VALUE = SYS$GET (UNIT->RAB,,);
    JUNK = LIB$SCOPY_R_DX (UNIT->RAB.RAB$W_RSZ, VALUE (UNIT -> RAB.RAB$L_UBF),
    	    LINE);
    IF ACTUALCOUNT > 2 &: PRESENT (LEN) THEN
    	POSINT (LEN) = UNIT -> RAB.RAB$W_RSZ;
    RETURN (STS$VALUE);

END MDM_READF;
%PAGE;
MDM_WRITEF: PROCEDURE (UNIT, LINE) RETURNS (VMS_COND_VALUE);
/*+

DESCRIPTION:	This procedure writes a record to a sequential file
    	    	opened for writing with MDM_OPENF.

RETURNS:    	cond_value, longword (unsigned), write only, by value

PROTOTYPE:

    MDM_WRITEF (unit, line)

unit:	fblk, longword (unsigned), modify, by reference
line:	char_string, character string, read only, by descriptor

COMPLETION CODES:   RMS$_NORMAL indicates normal successful completion.

-*/

    DECLARE (UNIT, LINE) POINTER VALUE;

%INCLUDE $STSDEF;

/********************** BEGIN EXECUTABLE CODE *********************/

    STS$VALUE = LIB$ANALYZE_SDESC(LINE, UNIT -> RAB.RAB$W_RSZ,
    	    	    UNIT -> RAB.RAB$L_RBF);
    IF ^STS$SUCCESS THEN RETURN (STS$VALUE);
    STS$VALUE = SYS$PUT (UNIT -> RAB,,);
    RETURN (STS$VALUE);

END MDM_WRITEF;
%PAGE;
MDM_RWNDF: PROCEDURE (UNIT) RETURNS (VMS_COND_VALUE);
/*+

DESCRIPTION:	This procedure rewinds a file opened by MDM_OPENF.

RETURNS:    	cond_value, longword (unsigned), write only, by value

PROTOTYPE:

    MDM_RWNDF (unit)

unit:	fblk, longword (unsigned), modify, by reference

COMPLETION CODES:   RMS$_NORMAL indicates normal successful completion.
    	    	    Other codes from SYS$REWIND are possible.

-*/

    DECLARE UNIT POINTER VALUE;

/********************** BEGIN EXECUTABLE CODE *********************/

    RETURN (SYS$REWIND (UNIT -> RAB,,));

END MDM_RWNDF;