MODULE XDCL ( IDENT = 'X00.04', %TITLE 'XPORT VAX/VMS DCL CLI Interface Routines' ADDRESSING_MODE( EXTERNAL=LONG_RELATIVE ) ) = BEGIN ! ! COPYRIGHT (c) 1979 BY ! DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ! ! 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 WHICH IS NOT SUPPLIED BY DIGITAL. ! !++ ! ! FACILITY: BLISS Library ! ! ABSTRACT: ! ! This module consists of general purpose VMS DCL CLI interface routines. ! ! ENVIRONMENT: User mode - VAX/VMS host system ! ! AUTHOR: Ward Clark, CREATION DATE: 26 June 1979 ! !-- ! ! TABLE OF CONTENTS: ! FORWARD ROUTINE xpo$char_parse : NOVALUE, ! Character value parsing routine xpo$short_parse : NOVALUE, ! Short integer parsing routine xpo$str_parse : NOVALUE, ! Quoted string parsing routine xpo$cli_error : NOVALUE; ! General purpose CLI error action routine ! ! INCLUDE FILES: ! LIBRARY 'XPORT' ; ! Public XPORT control block and macro definitions LIBRARY 'XPOSYS' ; ! Internal XPORT macro definitions $XPO_SYS_TEST( $VMS ) LIBRARY 'SYS$LIBRARY:CLIMAC' ; ! VMS DCL CLI interface macros REQUIRE 'XVMS' ; ! and symbol definitions ! ! MACROS: ! ! ! EQUATED SYMBOLS: ! ! ! PSECT DECLARATIONS: ! $XPO_PSECTS ! Declare XPORT PSECT names and attributes ! ! OWN STORAGE: ! GLOBAL xpo$cli_work : VECTOR[ CLI$C_WORKAREA, BYTE ]; ! DCL CLI work area OWN numb_parse_desc : ! Numeric value parse request descriptor: $CLIREQDESC( RQTYPE = NUMERVAL, ! numeric value parse indicator RQFLGS = , ! single value and absolute address indicators ERRACT = xpo$cli_error ), ! address of error action routine str_parse_desc : ! ASCII string parse request descriptor: $CLIREQDESC( RQTYPE = ASCIIVAL, ! ASCII string parse indicator RQFLGS = ABSADR, ! absolute address indicator ERRACT = xpo$cli_error ); ! address of error action routine ! ! EXTERNAL REFERENCES: ! %TITLE 'XPORT DCL Character Value Parser' GLOBAL ROUTINE xpo$char_parse( qualifier_desc ) : NOVALUE = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine parses a single character qualifier value and saves the value ! in the area pointed to by the qualifier descriptor. ! ! FORMAL PARAMETERS: ! ! qualifier_desc.r.r - address of a qualifier descriptor ! ! IMPLICIT INPUTS: ! ! numb_parse_desc - DCL CLI value parsing request descriptor ! ! IMPLICIT OUTPUTS: ! ! character value saved at ".qualifier_desc[CLI$L_USRVAL]" ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP qualifier_desc : REF BLOCK[,BYTE]; ! Redefine the qualifier descriptor parameter BIND deposit_area = ! Define the value deposit area .qualifier_desc[CLI$L_USRVAL] : BYTE; ! ! Parse a qualifier character value of the form "c". ! IF .qualifier_desc[CLI$W_QDVALSIZ] EQL 1 THEN deposit_area = ! Save the character value. CH$RCHAR( .qualifier_desc[CLI$A_QDVALADR] ) ! ! Parse a qualifier numeric value of the form 123, %X1FF or %O377. ! ELSE BEGIN $XPO_CALL_CLI( numb_parse_desc, xpo$cli_work, .qualifier_desc ); deposit_area = .numb_parse_desc[CLI$L_RQVALU]; ! Save the character value. END; ! ! Return to the CLI. ! RETURN END; %TITLE 'XPORT DCL Numeric Value Parser' GLOBAL ROUTINE xpo$short_parse( qualifier_desc ) : NOVALUE = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine parses a single numeric qualifier value and saves the value ! in a 2-byte area pointed to by the qualifier descriptor. ! ! FORMAL PARAMETERS: ! ! qualifier_desc.r.r - address of a qualifier descriptor ! ! IMPLICIT INPUTS: ! ! numb_parse_desc - DCL CLI value parsing request descriptor ! ! IMPLICIT OUTPUTS: ! ! numeric value saved at ".qualifier_desc[CLI$L_USRVAL]" ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP qualifier_desc : REF BLOCK[,BYTE]; ! Redefine the qualifier descriptor parameter BIND deposit_area = ! Define the value deposit area .qualifier_desc[CLI$L_USRVAL] : WORD; ! ! Parse a qualifier numeric value of the form 123, %X1FF or %O377. ! $XPO_CALL_CLI( numb_parse_desc, xpo$cli_work, .qualifier_desc ); deposit_area = .numb_parse_desc[CLI$L_RQVALU]; ! Save the character value. ! ! Return to the CLI. ! RETURN END; %TITLE 'XPORT DCL String Value Parser' GLOBAL ROUTINE xpo$str_parse( qualifier_desc ) : NOVALUE = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This routine parses a single ASCII string qualifier value and sets up ! a string descriptor in an area pointed to by the qualifier descriptor. ! ! FORMAL PARAMETERS: ! ! qualifier_desc.r.r - address of a qualifier descriptor ! ! IMPLICIT INPUTS: ! ! str_parse_desc - DCL CLI string parsing request descriptor ! ! IMPLICIT OUTPUTS: ! ! string descriptor at ".qualifier_desc[CLI$L_USRVAL]" is set up ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP qualifier_desc : REF BLOCK[,BYTE]; ! Redefine the qualifier descriptor parameter BIND string_desc = ! Define the string descriptor .qualifier_desc[CLI$L_USRVAL] : $STR_DESCRIPTOR(); ! ! Parse a quoted or unquoted ASCII string. ! $XPO_CALL_CLI( str_parse_desc, xpo$cli_work, .qualifier_desc ); $STR_DESC_INIT( DESCRIPTOR = string_desc, ! Setup the string descriptor. STRING = ( .str_parse_desc[CLI$W_RQSIZE], .str_parse_desc[CLI$A_RQADDR] ) ); ! ! Return to the CLI. ! RETURN END; %TITLE 'XPORT DCL CLI Error Action Routine' GLOBAL ROUTINE xpo$cli_error( cli_block, error_number ) : NOVALUE = !++ ! ! FUNCTIONAL DESCRIPTION: ! ! This DCL CLI error action routine sends a CLI error message to the user. ! ! FORMAL PARAMETERS: ! ! cli_block.ra.v - address of the associated CLI control block ! error_number - CLI error number ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! None ! ! SIDE EFFECTS: ! ! None ! !-- BEGIN MAP cli_block : REF BLOCK[,BYTE]; ! Redefine the CLI control block parameter ! ! Send the user a "syntax error" message and terminate program execution. ! SIGNAL_STOP( CLI$_SYNTAX, ! Signal "syntax error" with the following extra arguments: 1, ! number of message arguments cli_block[CLI$Q_RQDESC], ! address of command segment string descriptor .error_number ) ! DCL CLI error number (secondary message) END; END ELUDOM