%TITLE 'PARSER' MODULE PARSER = BEGIN !++ ! FACILITY: ! PARSER - CLI Interface ! ! ABSTRACT: ! This module implements a somewhat user friendly interface to ! the VMS CLI$ routines. Data structures to be used with this ! module may be created by using the macros in PARMAC.REQ. ! There are facilities to parse a command, a parameter, ! all qualifiers from a particular qualifier table, a file, ! etc. In cases where the qualifiers take values, defaults ! and ranges may be supplied in the table and PARSER will do ! the appropriate range checking and defaulting. ! ! AUTHORS: ! Antonino N.J. Mione, Rogelio Guardia, James Cheng ! AGAIN under the supervision ... ! ! CREATION DATE: START LOG DATE ! ! MODIFIED BY: CAPTAIN KIRK. ! 6-MAY-1985 ANM PARMAC - Made QUAL$A_KEYS into QUAL$A_ARGS ! and PARM$A_KEYS into PARM$A_ARGS ! PARSER - Working on PAR$PARSE_VALUE, ! PAR$PARSE_KEYWORD, PAR$INIT_QUALIFIER_TABLE, ! and PAR$INIT_PARAMETER_BLOCK ! ! 20-MAY-1985 RG PARSER- Working on PAR$PARSE_*. Changing the parameters ! that are passed to only a block address and ! the storage location. ! !-- %SBTTL 'TABLE OF CONTENTS' ! TABLE OF CONTENTS: %SBTTL 'FORWARD ROUTINES & NEEDED FILES' FORWARD ROUTINE STORE_LONGWORD, STORE_STRING, ELEMENT_IS_PRESENT, PAR$PARSE_ONE_VALUE, PAR$PARSE_VALUE; ! INCLUDE FILES: LIBRARY 'SYS$LIBRARY:XPORT'; LIBRARY 'SYS$LIBRARY:STARLET'; REQUIRE 'PARMAC.REQ'; %SBTTL 'MACROS & LITERALS' ! MACROS: MACRO ! $LONGWORD and $$LONGWORD are used to define a parameter being passed ! by reference to a routine. $LONGWORD = REF BLOCK[1, LONG] %, $$LONGWORD = REF VECTOR[1, LONG] %; ! EQUATED SYMBOLS: LITERAL TRUE = 0 EQL 0, FALSE = NOT TRUE; %SBTTL 'EXTERNAL REFERENCES' ! EXTERNAL REFERENCES: EXTERNAL ROUTINE CLI$PRESENT : ADDRESSING_MODE (GENERAL), CLI$GET_VALUE : ADDRESSING_MODE (GENERAL), LIB$FREE_VM : ADDRESSING_MODE (GENERAL) NOVALUE, LIB$SIGNAL : ADDRESSING_MODE (GENERAL), LIB$MATCHC : ADDRESSING_MODE (GENERAL), STR$COPY_DX : ADDRESSING_MODE (GENERAL); EXTERNAL LITERAL PAR_KEYNOTFOUND, PAR_VALUETRUNC, PAR_MUSTBEDESC, PAR_FILESPECTOOLONG, PAR_BADDIGIT, PAR_STRINGTOOLONG, PAR_VALUEOUTOFRANGE; ! Symbols for CLI$ stuff EXTERNAL LITERAL CLI$_PRESENT, CLI$_LOCPRES, CLI$_LOCNEG, CLI$_NEGATED, CLI$_DEFAULTED, CLI$_ABSENT, CLI$_COMMA, CLI$_CONCAT, CLI$_ABSENT; %SBTTL 'PAR$INIT_QUALIFIER_TABLE' GLOBAL ROUTINE PAR$INIT_QUALIFIER_TABLE (Q_TABLE, Q_VALUE_CNTS, Q_COUNT) = !++ ! FUNCTIONAL DESCRIPTION: ! ! PAR$INIT_QUALIFIER_TABLE will initialize the qualifier table and ! its associated value counts table to indicate no qualifiers ! were parsed. This should precede using the PAR$PARSE_QUALIFIERS ! since qualifier arguments may be left around from a previous ! call to that routine. ! ! FORMAL PARAMETERS: ! ! Q_TABLE - Address of the Qualifier-block table ! Q_VALUE_CNTS - Address of the Qualifier-value-count vector ! Q_COUNT - Sequence number of last qualifier in table (# of quals - 1) ! ! IMPLICIT INPUTS: ! ! Qualifier table and Value count table ! ! IMPLICIT OUTPUTS: ! ! Same as implicit inputs ! ! ROUTINE VALUE: ! ! True or False ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN LOCAL DESC_ADDRESS : REF $BBLOCK[], ! Temp descriptor addr STORAGE_ADDRESS : REF VECTOR[0, BYTE], STORAGE_INDEX; MAP Q_TABLE : REF BLOCKVECTOR [0, QUALIFIER_BLOCK_SIZE] FIELD (QUALIF_FIELDS), Q_VALUE_CNTS : REF VECTOR [0]; ! Loop thru the entire qual table INCR Q_INDEX FROM 0 TO (.Q_COUNT - 1) DO BEGIN ! Set the values in the qualifier tables to false (-1) Q_VALUE_CNTS [.Q_INDEX] = -1; IF (.Q_TABLE [.Q_INDEX, QUAL$V_TAKES_VALUE]) THEN BEGIN ! If this element of the qual table takes a value then DESC_ADDRESS = .Q_TABLE [.Q_INDEX, QUAL$A_STORAGE]; IF (.Q_TABLE [.Q_INDEX, QUAL$V_STORAGE_IS_DESCRIPTOR]) THEN IF (.DESC_ADDRESS [DSC$B_CLASS] EQL DSC$K_CLASS_D) THEN ! Descriptor is dynamic BEGIN IF (.DESC_ADDRESS [DSC$A_POINTER] NEQ 0) AND (.DESC_ADDRESS [DSC$W_LENGTH] NEQ 0) THEN LIB$FREE_VM ( %REF (.DESC_ADDRESS [DSC$W_LENGTH]), DESC_ADDRESS [DSC$A_POINTER] ); DESC_ADDRESS [DSC$W_LENGTH] = 0; ! length of storage, DESC_ADDRESS [DSC$A_POINTER] = 0; ! and address of storage pointer END ELSE BEGIN STORAGE_ADDRESS = .DESC_ADDRESS[ DSC$A_POINTER ]; INCR STORAGE_INDEX FROM 0 TO (.Q_TABLE[ .Q_INDEX, QUAL$W_MAX_LENGTH ] - 1) DO STORAGE_ADDRESS[ .STORAGE_INDEX ] = 0 END ELSE ! No, it is not a descriptor BEGIN MAP DESC_ADDRESS : REF VECTOR[0, BYTE]; INCR STORAGE_INDEX FROM 0 TO (.Q_TABLE[ .Q_INDEX, QUAL$W_MAX_LENGTH ] - 1) DO DESC_ADDRESS[ .STORAGE_INDEX ] = 0 END END; ! IF (...QUAL$V_TAKESVALUE...) END; ! Incr .. from 0 to ... RETURN TRUE END; %SBTTL 'PAR$INIT_PARAMETER_BLOCK' GLOBAL ROUTINE PAR$INIT_PARAMETER_BLOCK (P_BLOCK) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will clear the storage area of a parameter block. ! This should be done before a call to PAR$PARSE_PARAMETER for ! a particular parameter to keep any residual data from a ! previous call to interfere with the value returned. ! ! FORMAL PARAMETERS: ! ! P_BLOCK - Address of the parameter description block ! ! IMPLICIT INPUTS: ! ! The parameter block ! ! IMPLICIT OUTPUTS: ! ! Same as implicit inputs ! ! ROUTINE VALUE: ! ! True or False ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN LOCAL DESC_ADDRESS : LONG UNSIGNED, ! Temp. descriptor address STORAGE_ADDRESS : REF VECTOR[0, BYTE], STORAGE_INDEX; MAP DESC_ADDRESS : REF $BBLOCK[], P_BLOCK : REF BLOCK [PARAMETER_BLOCK_SIZE] FIELD (PARAM_FIELDS); ! Get the address of the descriptor DESC_ADDRESS = .P_BLOCK [PARM$A_STORAGE]; IF (.P_BLOCK [PARM$V_STORAGE_IS_DESCRIPTOR]) ! Is it a descriptor ? THEN BEGIN ! Yes, it is a descriptor. IF (.DESC_ADDRESS [DSC$B_CLASS] EQL DSC$K_CLASS_D) ! Is descriptor dynamic ? THEN ! Yes, BEGIN IF (DESC_ADDRESS [DSC$A_POINTER] NEQ 0) AND (.DESC_ADDRESS [DSC$W_LENGTH] NEQ 0) THEN LIB$FREE_VM( ! deallocated the dynamic memory %REF (.DESC_ADDRESS [DSC$W_LENGTH]), DESC_ADDRESS [DSC$A_POINTER]); DESC_ADDRESS [DSC$A_POINTER] = 0; DESC_ADDRESS [DSC$W_LENGTH] = 0 END ELSE BEGIN STORAGE_ADDRESS = .DESC_ADDRESS[ DSC$A_POINTER ]; INCR STORAGE_INDEX FROM 0 TO (.P_BLOCK[ PARM$W_MAX_LENGTH ] - 1) DO STORAGE_ADDRESS[ .STORAGE_INDEX ] = 0 END END ELSE ! No, it is not a descriptor BEGIN MAP DESC_ADDRESS : REF VECTOR[0, BYTE]; INCR STORAGE_INDEX FROM 0 TO (.P_BLOCK[ PARM$W_MAX_LENGTH ] - 1) DO DESC_ADDRESS[ .STORAGE_INDEX ] = 0 END; RETURN TRUE END; %SBTTL 'PAR$PARSE_QUALIFIERS' GLOBAL ROUTINE PAR$PARSE_QUALIFIERS (Q_TABLE, Q_VALUE_CNTS, Q_COUNT) = !++ ! FUNCTIONAL DESCRIPTION: ! ! Par$Parse_Qualifiers scans the qualifier table pointed at by ! Q_TABLE and calls the CLI$ routines to return the requested ! values. This routine also fills in defaults when qualifiers ! are not specified, etc. ! ! FORMAL PARAMETERS: ! ! Q_TABLE - Address of the qualifier table ! Q_VALUE_CNTS - Address of value count vector ! Q_COUNT - Number of qualifiers in the qualifier table ! ! IMPLICIT INPUTS: ! ! The qualifier table and its associated value_cnts table. ! ! IMPLICIT OUTPUTS: ! ! Same as implicit inputs ! ! ROUTINE VALUE: ! ! True or False. ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN MAP Q_TABLE : REF BLOCKVECTOR [0, QUALIFIER_BLOCK_SIZE] FIELD (QUALIF_FIELDS), Q_VALUE_CNTS : REF VECTOR [0]; INCR Q_INDEX FROM 0 TO (.Q_COUNT - 1) ! for all qualifiers DO IF (ELEMENT_IS_PRESENT (Q_TABLE [.Q_INDEX,QUAL$D_KEYWORD])) THEN BEGIN ! yes, qualifier is present Q_VALUE_CNTS [.Q_INDEX] = 0; ! Show that the qualifier was present IF (.Q_TABLE [.Q_INDEX, QUAL$V_TAKES_VALUE]) ! does the qualifier takes value? THEN ! yes, Q_VALUE_CNTS [.Q_INDEX] = PAR$PARSE_VALUE (.Q_TABLE, .Q_INDEX); ! go get it END; RETURN TRUE END; %SBTTL 'PAR$PARSE_PARAMETER' GLOBAL ROUTINE PAR$PARSE_PARAMETER ( P_BLOCK ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will call the CLI$ routines to find a value for ! the parameter described by P_BLOCK. ! ! FORMAL PARAMETERS: ! ! P_BLOCK - Pointer to a parameter description block. The format ! of this block is the same as one entry of a qualifier ! table. ! ! IMPLICIT INPUTS: ! ! The parameter block. ! ! IMPLICIT OUTPUTS: ! ! Same as implicit inputs ! ! ROUTINE VALUE: ! ! True or False ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN MAP P_BLOCK : REF BLOCK [PARAMETER_BLOCK_SIZE] FIELD (PARAM_FIELDS); ! Determine if the Parameter was present IF (ELEMENT_IS_PRESENT (P_BLOCK [PARM$D_KEYWORD])) THEN ! yes, parameter is present or negated IF (.P_BLOCK [PARM$V_TAKES_VALUE]) ! does the parameter take a value? THEN ! yes, RETURN PAR$PARSE_ONE_VALUE ( .P_BLOCK, 0 ); ! go get it RETURN TRUE END; %SBTTL 'PAR$PARSE_AN_ELEMENT' GLOBAL ROUTINE PAR$PARSE_AN_ELEMENT( P_BLOCK : REF BLOCK [PARAMETER_BLOCK_SIZE] FIELD (PARAM_FIELDS), Q_TABLE : REF BLOCKVECTOR [0, QUALIFIER_BLOCK_SIZE] FIELD (QUALIF_FIELDS), Q_VALUE_CNTS : REF VECTOR [0], Q_COUNT ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is used to get one element of a parameter and the qualifiers ! associated with it. ! ! FORMAL PARAMETERS: ! ! P_BLOCK => Address of parameter block descriptor ! Q_TABLE => Address of qualifier table descriptor ! Q_VALUE_CNTS => Address of value count vector ! Q_COUNT => Number of qualifiers in the qualifier table ! ! ! IMPLICIT INPUTS: ! ! The qualifier table and its associated value conts table ! ! IMPLICIT OUTPUTS: ! ! Same as implicit inputs ! ! ROUTINE VALUE ! ! True or False ! ! SIDE EFFECTS: ! ! NONE !-- BEGIN LOCAL STATUS : INITIAL(TRUE); IF (STATUS = PAR$INIT_PARAMETER_BLOCK ( .P_BLOCK)) THEN STATUS = PAR$PARSE_PARAMETER( .P_BLOCK ); IF .STATUS THEN STATUS = PAR$INIT_QUALIFIER_TABLE( .Q_TABLE, .Q_VALUE_CNTS, .Q_COUNT ); IF .STATUS THEN STATUS = PAR$PARSE_QUALIFIERS( .Q_TABLE, .Q_VALUE_CNTS, .Q_COUNT ); RETURN .STATUS END; %SBTTL 'PAR$PARSE_VALUE' ROUTINE PAR$PARSE_VALUE (TABLE, INDEX) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called by the qualifier and parameter parsing routines ! to get value associated with the associated keyword. ! ! FORMAL PARAMETERS: ! ! TABLE => Table containing the keyword for whose value we are getting ! INDEX => Index into the table for the proper keyword ! ! IMPLICIT INPUTS: ! ! Predefined table of keywords ! ! IMPLICIT OUTPUTS: ! ! Same as implicit inputs ! ! ROUTINE VALUE: ! ! True or False ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN LOCAL CURRENT_STORAGE_LOCATION, CURRENT_VALUE_CNT, STORAGE_DESC : REF BLOCKVECTOR[ 0, DSC$K_D_BLN, BYTE ], STATUS :INITIAL(TRUE); MAP TABLE : REF BLOCKVECTOR [0, QUALIFIER_BLOCK_SIZE] FIELD (QUALIF_FIELDS); ! Initialize the value count CURRENT_VALUE_CNT = 0; IF (.TABLE [.INDEX, QUAL$V_STORAGE_IS_DESCRIPTOR]) THEN BEGIN ! If its a descriptor, point to it (or 1st in list of descriptors) STORAGE_DESC = .TABLE [.INDEX, QUAL$A_STORAGE]; CURRENT_STORAGE_LOCATION = STORAGE_DESC [ 0, DSC$D_DESC_BASE ] END ELSE ! Otherwise, point at block of storage CURRENT_STORAGE_LOCATION = .TABLE [.INDEX, QUAL$A_STORAGE]; ! The WHILE condition checks whether we have room for another value in ! the storage block. If so, it does the IF statement. WHILE (.CURRENT_VALUE_CNT LSS .TABLE [.INDEX, QUAL$W_MAX_ARGCOUNT]) DO ! This calls the appropriate parse routine for the particular ! type of value we are looking for. If STATUS is true, ! another value was found and is in the storage block. ! If it was false, then the routine failed to find a ! value and we should exit from the WHILE loop. IF (STATUS = (.TABLE [.INDEX, QUAL$A_ROUTINE]) (TABLE [.INDEX, QUAL$G_QBLOCK_BASE], .CURRENT_STORAGE_LOCATION)) THEN BEGIN ! Up the count of values we have parsed and point to ! the next chunk of storage. CURRENT_VALUE_CNT = .CURRENT_VALUE_CNT + 1; IF (.TABLE [.INDEX, QUAL$V_STORAGE_IS_DESCRIPTOR]) THEN BEGIN ! Fetch address of next descriptor CURRENT_STORAGE_LOCATION = STORAGE_DESC [ .CURRENT_VALUE_CNT, DSC$D_DESC_BASE ] END ELSE ! Or... update pointer into block of storage CURRENT_STORAGE_LOCATION = .CURRENT_STORAGE_LOCATION + .TABLE [.INDEX, QUAL$W_MAX_LENGTH] END ELSE ! No more values... EXITLOOP; RETURN .CURRENT_VALUE_CNT ! Tell caller how many we parsed. END; %SBTTL 'PAR$PARSE_ONE_VALUE' ROUTINE PAR$PARSE_ONE_VALUE (TABLE, INDEX) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is used to parse one value associated with a keyword defined ! in the table and referenced by the index ! ! FORMAL PARAMETERS: ! ! TABLE => Address of the block containing the keyword ! INDEX => Index into table (gives us the keyword) ! ! IMPLICIT INPUTS: ! ! Predefined keyword table ! ! IMPLICIT OUTPUTS: ! ! Same as implicit inputs ! ! ROUTINE VALUE: ! ! True or False ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN LOCAL CURRENT_STORAGE_LOCATION, STORAGE_DESC : REF BLOCKVECTOR[ 0, DSC$K_D_BLN, BYTE ]; MAP TABLE : REF BLOCKVECTOR [0, QUALIFIER_BLOCK_SIZE] FIELD (QUALIF_FIELDS); IF (.TABLE [.INDEX, QUAL$V_STORAGE_IS_DESCRIPTOR]) THEN BEGIN ! If its a descriptor, point to it (or 1st in list of descriptors) STORAGE_DESC = .TABLE [.INDEX, QUAL$A_STORAGE]; CURRENT_STORAGE_LOCATION = STORAGE_DESC [ 0, DSC$D_DESC_BASE ] END ELSE ! Otherwise, point at block of storage CURRENT_STORAGE_LOCATION = .TABLE [.INDEX, QUAL$A_STORAGE]; ! This calls the appropriate parse routine for the particular ! type of value we are looking for. If STATUS is true, ! another value was found and is in the storage block. ! If it was false, then the routine failed to find a ! value. RETURN (.TABLE [.INDEX, QUAL$A_ROUTINE]) (TABLE [.INDEX, QUAL$G_QBLOCK_BASE], .CURRENT_STORAGE_LOCATION) END; %SBTTL 'PAR$PARSE_FILE' GLOBAL ROUTINE PAR$PARSE_FILE( FILE_ROUTINE_BLOCK : REF BLOCK[ QUALIFIER_BLOCK_SIZE ] FIELD (QUALIF_FIELDS), VALUE_ADDRESS : REF BLOCK[0, BYTE] ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will try to fetch a filespec from the CLI$ routines. ! It will return the string representing the file in the ! string descriptor pointed at by VALUE_ADDRESS. ! ! FORMAL PARAMETERS: ! ! FILE_ROUTINE_BLOCK - The address of the block for the file in question. ! VALUE_ADDRESS - Address of storage for result of parse ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! True or False ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN LOCAL STATUS :INITIAL(TRUE), STR_BLOCK : $BBLOCK [ DSC$K_D_BLN ] PRESET ([DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_D); IF (STATUS = CLI$GET_VALUE (FILE_ROUTINE_BLOCK[QUAL$D_KEYWORD], STR_BLOCK)) THEN BEGIN IF (FILE_ROUTINE_BLOCK[QUAL$W_MAX_LENGTH] LSSU .STR_BLOCK [DSC$W_LENGTH]) THEN BEGIN STATUS = PAR_FILESPECTOOLONG; LIB$SIGNAL(.STATUS) END; IF (.STATUS) ! If we succeeded, store the value THEN STORE_STRING( .VALUE_ADDRESS, STR_BLOCK, .FILE_ROUTINE_BLOCK[QUAL$W_MAX_LENGTH], .FILE_ROUTINE_BLOCK[QUAL$L_FLAGS]) END; RETURN .STATUS END; %SBTTL 'PAR$PARSE_KEYWORD' GLOBAL ROUTINE PAR$PARSE_KEYWORD ( QUALIFIER_BLOCK : REF BLOCK[ QUALIFIER_BLOCK_SIZE] FIELD (QUALIF_FIELDS), VALUE_ADDRESS : REF BLOCK[0, BYTE] ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will parse a keyword from the table pointed at (indirectly) by ! KEYWORD_ROUTINE_ARGS. It will return the value for the keyword(s) parsed ! in storage which is pointed to by VALUE_ADDRESS. ! ! FORMAL PARAMETERS: ! ! QUALIFIER_BLOCK - The address of the block for the keyword in question. ! VALUE_ADDRESS - Address of storage for result of parse ! ! IMPLICIT INPUTS: ! ! Keyword table and storage for output ! ! IMPLICIT OUTPUTS: ! ! Same as implicit inputs ! ! ROUTINE VALUE: ! ! True or False ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN LITERAL KEY_TABLE_LENGTH = 0, KEY_TABLE_ADDRESS = 1, MAX_KEY_LENGTH = 80; LOCAL STATUS : INITIAL(TRUE), STR_BLOCK : $BBLOCK [ DSC$K_D_BLN ] PRESET ([DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_D), KEYWORD_TABLE : REF BLOCKVECTOR[0, KEYWORD_BLOCK_SIZE] FIELD(KEYWORD_FIELDS), KEYWORD_TABLE_LENGTH, KEYS_SCANNED_COUNT; BIND KEYWORD_ROUTINE_ARGS = QUALIFIER_BLOCK [ QUAL$A_ARGS] : REF VECTOR [2, LONG]; ! Get the address of the keyword table KEYWORD_TABLE = .KEYWORD_ROUTINE_ARGS[ KEY_TABLE_ADDRESS]; KEYWORD_TABLE_LENGTH = .KEYWORD_ROUTINE_ARGS[ KEY_TABLE_LENGTH]; IF (STATUS = CLI$GET_VALUE (QUALIFIER_BLOCK[QUAL$D_KEYWORD], STR_BLOCK)) THEN BEGIN KEYS_SCANNED_COUNT = 0; DO IF (LIB$MATCHC( STR_BLOCK, KEYWORD_TABLE[ .KEYS_SCANNED_COUNT, KEY$D_KEYWORD ]) EQL 1) THEN BEGIN STATUS = TRUE; EXITLOOP END ELSE BEGIN KEYS_SCANNED_COUNT = .KEYS_SCANNED_COUNT + 1; STATUS = PAR_KEYNOTFOUND END UNTIL (.KEYS_SCANNED_COUNT GEQ .KEYWORD_TABLE_LENGTH) ; IF (.STATUS) ! If we succeeded, store the value THEN STATUS = STORE_LONGWORD( .VALUE_ADDRESS, .KEYWORD_TABLE[ .KEYS_SCANNED_COUNT, KEY$A_VALUE ], .QUALIFIER_BLOCK[QUAL$W_MAX_LENGTH], .QUALIFIER_BLOCK[QUAL$L_FLAGS]) END; RETURN .STATUS END; %SBTTL 'PAR$PARSE_INTEGER' GLOBAL ROUTINE PAR$PARSE_INTEGER( QUALIFIER_BLOCK : REF BLOCK[ QUALIFIER_BLOCK_SIZE] FIELD (QUALIF_FIELDS), VALUE_ADDRESS : REF BLOCK[0, BYTE] ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is used to parse integer values. It will use any ! radix given to it up to radix 39. ! ! FORMAL PARAMETERS: ! ! QUALIFIER_BLOCK - Address of the qualifier block which holds certain ! necessary pieces of data. ! VALUE_ADDRESS - Address of location in which to store the value parsed. ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! True or False ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN LOCAL STATUS : INITIAL(TRUE), STR_BLOCK : $BBLOCK [ DSC$K_D_BLN ] PRESET ([DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_D), NEGATE_VALUE : INITIAL(FALSE), THE_RADIX : INITIAL(0), DIGIT_VALUE : INITIAL(0), INTEGER_VALUE : INITIAL(0); THE_RADIX = .QUALIFIER_BLOCK[QUAL$A_ARGS]; ! Get the radix value IF .THE_RADIX EQL 0 THEN THE_RADIX = 10; IF (STATUS = CLI$GET_VALUE (QUALIFIER_BLOCK[QUAL$D_KEYWORD], STR_BLOCK)) THEN BEGIN BIND INTEGER_STRING_ADDRESS = STR_BLOCK[ DSC$A_POINTER ] : REF VECTOR[0, BYTE]; INCR TEMP_INDEX FROM 0 TO (.STR_BLOCK[ DSC$W_LENGTH ] - 1) DO BEGIN SELECTONE .INTEGER_STRING_ADDRESS[ .TEMP_INDEX ] OF SET [%C'-']: ! Number is negative IF (.TEMP_INDEX EQL 0) THEN NEGATE_VALUE = TRUE ELSE LIB$SIGNAL(PAR_BADDIGIT); [%C'0' TO %C'9']: ! Case where character is numeric digit DIGIT_VALUE = .INTEGER_STRING_ADDRESS[ .TEMP_INDEX ] - %C'0'; ! Derive value of digit [%C'a' TO %C'z' ]: ! Case where digit > 9 (Radix 16 etc.) DIGIT_VALUE = .INTEGER_STRING_ADDRESS[ .TEMP_INDEX ] - %C'a' + 10; ! Derive digit value [%C'A' TO %C'Z' ]: ! Case where digit > 9 (Radix 16, etc.) DIGIT_VALUE = .INTEGER_STRING_ADDRESS[ .TEMP_INDEX ] - %C'A' + 10; ! Derive digit value TES; IF (.DIGIT_VALUE GEQ .THE_RADIX) THEN BEGIN STATUS = PAR_BADDIGIT; ! Not within radix, error LIB$SIGNAL(.STATUS); EXITLOOP END ELSE INTEGER_VALUE = .INTEGER_VALUE * .THE_RADIX + .DIGIT_VALUE END END; IF (.NEGATE_VALUE) THEN ! Negate the number INTEGER_VALUE = -(.INTEGER_VALUE); BEGIN ! So we can BIND The_flags BIND THE_FLAGS = QUALIFIER_BLOCK[ QUAL$L_FLAGS ] : BITVECTOR[32]; IF (.THE_FLAGS[ QUAL$K_VALUE_IS_SIGNED ]) THEN BEGIN IF ( .INTEGER_VALUE LSS .QUALIFIER_BLOCK[ QUAL$A_RANGE_LOW ] OR .INTEGER_VALUE GTR .QUALIFIER_BLOCK[ QUAL$A_RANGE_HIGH ] ) THEN BEGIN STATUS = PAR_VALUEOUTOFRANGE; ! Value is outside the range LIB$SIGNAL(.STATUS); END END ELSE IF ( .INTEGER_VALUE LSSU .QUALIFIER_BLOCK[ QUAL$A_RANGE_LOW ] OR .INTEGER_VALUE GTRU .QUALIFIER_BLOCK[ QUAL$A_RANGE_HIGH ] ) THEN BEGIN STATUS = PAR_VALUEOUTOFRANGE; ! Value is outside the range LIB$SIGNAL(.STATUS); END END; ! The Begin-end for the BIND IF .STATUS THEN STATUS = STORE_LONGWORD(.VALUE_ADDRESS, .INTEGER_VALUE, .QUALIFIER_BLOCK[QUAL$W_MAX_LENGTH], .QUALIFIER_BLOCK[QUAL$L_FLAGS]); RETURN .STATUS END; %SBTTL 'PAR$PARSE_STRING' GLOBAL ROUTINE PAR$PARSE_STRING( STRING_ROUTINE_BLOCK : REF BLOCK[ QUALIFIER_BLOCK_SIZE, LONG] FIELD (QUALIF_FIELDS), VALUE_ADDRESS : REF BLOCK[0, BYTE] ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is used to parse string values. ! ! FORMAL PARAMETERS: ! ! STRING_ROUTINE_BLOCK - The address of the block for the string in question. ! VALUE_ADDRESS - Address of storage for result of parse ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE VALUE: ! ! True or False ! ! SIDE EFFECTS: ! ! NONE ! !-- BEGIN LOCAL STATUS : INITIAL(TRUE), STR_BLOCK : $BBLOCK [ DSC$K_D_BLN ] PRESET ([DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_D); IF (STATUS = CLI$GET_VALUE (STRING_ROUTINE_BLOCK[QUAL$D_KEYWORD], STR_BLOCK)) THEN BEGIN IF (STRING_ROUTINE_BLOCK[QUAL$W_MAX_LENGTH] LSSU .STR_BLOCK [DSC$W_LENGTH]) THEN BEGIN STATUS = PAR_STRINGTOOLONG; LIB$SIGNAL(.STATUS) END; IF (.STATUS) ! If we succeeded, store the value THEN STORE_STRING(.VALUE_ADDRESS, STR_BLOCK, .STRING_ROUTINE_BLOCK[QUAL$W_MAX_LENGTH], .STRING_ROUTINE_BLOCK[QUAL$L_FLAGS]) END; RETURN .STATUS END; %SBTTL 'Support routine - ELEMENT IS PRESENT' ROUTINE ELEMENT_IS_PRESENT (ELEMENT) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to determine if an element in the command line was ! present or not. An element is either a qualifier or a parameter. ! ! FORMAL PARAMETERS: ! ! ELEMENT => Qualifier or Parameter we are looking for ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE_VALUE: ! ! True or False ! ! SIDE EFFECTS: ! ! None !-- BEGIN LOCAL CLI_STATUS : INITIAL(CLI$_ABSENT); ! Determine if the element we are searching for was present CLI_STATUS = CLI$PRESENT (.ELEMENT); IF (.CLI_STATUS EQL CLI$_PRESENT) OR (.CLI_STATUS EQL CLI$_LOCPRES) OR (.CLI_STATUS EQL CLI$_DEFAULTED) THEN RETURN TRUE ELSE RETURN FALSE; END; %SBTTL 'STORE_LONGWORD' ROUTINE STORE_LONGWORD( STORAGE_ADDRESS : $LONGWORD, VALUE_TO_STORE, MAX_LENGTH, FLAG_WORD : BITVECTOR) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will take a value of arbitrary length and store ! it into a qualifier's or parameter's storage area. If the ! storage is a dynamic descriptor, space will be allocated for ! the value. ! ! FORMAL PARAMETERS: ! ! STORAGE_ADDRESS - Address of storage block or descriptor ! VALUE_TO_STORE - Address of string, integer, etc. to be stored ! MAX_LENGTH - Maximum number of bytes available ! FLAG_WORD - Flags from qualifier or parameter block ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE_VALUE: ! ! True or False ! ! SIDE EFFECTS: ! ! NONE !-- BEGIN LOCAL MIN_VALUE_THAT_CAN_FIT : INITIAL(0), MAX_VALUE_THAT_CAN_FIT; ! First, make sure that the value will fit in storage. IF (.FLAG_WORD[ QUAL$K_VALUE_IS_SIGNED ]) THEN BEGIN ! Value is signed, calculate max and min values MAX_VALUE_THAT_CAN_FIT = 1 ^ (.MAX_LENGTH * %BPUNIT - 1) - 1; MIN_VALUE_THAT_CAN_FIT = - (1 ^ (.MAX_LENGTH * %BPUNIT - 1)) END ELSE ! Value is unsigned, calculate max only MAX_VALUE_THAT_CAN_FIT = 1 ^ (.MAX_LENGTH * %BPUNIT) - 1; IF (.FLAG_WORD[ QUAL$K_VALUE_IS_SIGNED ]) THEN BEGIN IF (.VALUE_TO_STORE GTR .MAX_VALUE_THAT_CAN_FIT) OR (.VALUE_TO_STORE LSS .MIN_VALUE_THAT_CAN_FIT) THEN ! Value is out of range. Tell user about it BEGIN LIB$SIGNAL(PAR_VALUETRUNC); RETURN FALSE END END ELSE IF (.VALUE_TO_STORE GTRU .MAX_VALUE_THAT_CAN_FIT) OR (.VALUE_TO_STORE LSSU .MIN_VALUE_THAT_CAN_FIT) THEN ! Value is out of range. Tell user about it BEGIN LIB$SIGNAL(PAR_VALUETRUNC); RETURN FALSE END; STORAGE_ADDRESS[ 0, 0, %BPUNIT * .MAX_LENGTH, 0 ] = .VALUE_TO_STORE; RETURN TRUE END; %SBTTL 'STORE_STRING' ROUTINE STORE_STRING( STORAGE_ADDRESS : $LONGWORD, VALUE_TO_STORE : REF $BBLOCK[ DSC$C_Z_BLN ], MAX_LENGTH, FLAG_WORD : BITVECTOR) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will will copy a string from one place in storage to ! another. It is used for storing string values into qualifier ! or parameter storage areas. ! ! FORMAL PARAMETERS: ! ! STORAGE_ADDRESS - Pointer to storage or descriptor ! VALUE_TO_STORE - Address of descriptor for source string ! MAX_LENGTH - Maximum number of bytes the value may occupy ! FLAG_WORD - The flag word from the qualifier or parameter block ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! ROUTINE_VALUE: ! ! True - String copied successfully ! PAR_VALUETRUNC - The string was truncated ! ! SIDE EFFECTS: ! ! NONE !-- BEGIN LOCAL STATUS : INITIAL(TRUE), BYTES_TO_COPY, TEMP_STORAGE_DESC : $BBLOCK[ DSC$K_D_BLN ] PRESET ([DSC$B_DTYPE] = DSC$K_DTYPE_T, ! Text [DSC$B_CLASS] = DSC$K_CLASS_S); ! Fixed-length descriptor BYTES_TO_COPY = MIN(.MAX_LENGTH, .VALUE_TO_STORE[ DSC$W_LENGTH ]); IF (.FLAG_WORD[ QUAL$K_STORAGE_IS_DESCRIPTOR ]) THEN STATUS = STR$COPY_DX( .STORAGE_ADDRESS, .VALUE_TO_STORE ) ELSE BEGIN TEMP_STORAGE_DESC[DSC$A_POINTER] = .STORAGE_ADDRESS; ! Address of storage block TEMP_STORAGE_DESC[DSC$W_LENGTH] = .MAX_LENGTH; ! Size of available storage STATUS = STR$COPY_DX( TEMP_STORAGE_DESC, .VALUE_TO_STORE ) END; IF (NOT .STATUS) THEN RETURN PAR_VALUETRUNC; RETURN .STATUS END; %SBTTL 'END OF MODULE' END ! End of module ELUDOM