INTEGER*4 FUNCTION Q_UPCASE( DST_STR, SRC_STR ) C --------------------------------------------------------------------------- C QUPCASE.FOR - The function of this routine is to translate lower case C characters to upper case characters. However, any characters C which have had their most significent bit set will not be affected. C The Q_ENCODE routine would be the one setting the most significent C bit of characters. C C Only characters in the range of '61'x - '7A'x will be translated C to upper case. C C Calling Procedure: C C status = Q_UPCASE( dst_str, src_str ) C C Entry Conditions: C C src_str - is the address of a character string descriptor. The C string must contain the characters to be translated to C upper case. C C Exit Conditions: C C dst_str - is the address of a character string descriptor. The C string is where the translated results will be stored. This C can be the same string as the src_str if desired. C C status - is the completion return status. C C SS$_NORMAL C SS$_STRTRU - string truncated because destination string C was shorter than input string. C C --------------------------------------------------------------------------- C IMPLICIT INTEGER*4 (A-Z) C CHARACTER SRC_STR*(*) CHARACTER DST_STR*(*) C CHARACTER*(1) UP_TBL(256) BYTE UP_TBL_B(256) BYTE UP_TBL_1(128) BYTE UP_TBL_2(128) EQUIVALENCE ( UP_TBL, UP_TBL_B ) EQUIVALENCE ( UP_TBL_B, UP_TBL_1 ) EQUIVALENCE ( UP_TBL_B(129), UP_TBL_2 ) C DATA UP_TBL_1 / 1 '00'x, '01'x, '02'x, '03'x, '04'x, '05'x, '06'x, '07'x, ! ctl char 1 '08'x, '09'x, '0A'x, '0B'x, '0C'x, '0D'x, '0E'x, '0F'x, ! ctl char 1 '10'x, '11'x, '12'x, '13'x, '14'x, '15'x, '16'x, '17'x, ! ctl char 1 '18'x, '19'x, '1A'x, '1B'x, '1C'x, '1D'x, '1E'x, '1F'x, ! ctl char 1 '20'x, '21'x, '22'x, '23'x, '24'x, '25'x, '26'x, '27'x, ! sp !"#$%&' 1 '28'x, '29'x, '2A'x, '2B'x, '2C'x, '2D'x, '2E'x, '2F'x, ! ()*+,-./ 1 '30'x, '31'x, '32'x, '33'x, '34'x, '35'x, '36'x, '37'x, ! 01234567 1 '38'x, '39'x, '3A'x, '3B'x, '3C'x, '3D'x, '3E'x, '3F'x, ! 89:;<=>? 1 '40'x, '41'x, '42'x, '43'x, '44'x, '45'x, '46'x, '47'x, ! @ABCDEFG 1 '48'x, '49'x, '4A'x, '4B'x, '4C'x, '4D'x, '4E'x, '4F'x, ! HIJKLMNO 1 '50'x, '51'x, '52'x, '53'x, '54'x, '55'x, '56'x, '57'x, ! PQRSTUVW 1 '58'x, '59'x, '5A'x, '5B'x, '5C'x, '5D'x, '5E'x, '5F'x, ! XYZ[\]^_ 1 '60'x, '41'x, '42'x, '43'x, '44'x, '45'x, '46'x, '47'x, ! `abcdefg 1 '48'x, '49'x, '4A'x, '4B'x, '4C'x, '4D'x, '4E'x, '4F'x, ! hijklmno 1 '50'x, '51'x, '52'x, '53'x, '54'x, '55'x, '56'x, '57'x, ! pqrstuvw 1 '58'x, '59'x, '5A'x, '7B'x, '7C'x, '7D'x, '7E'x, '7F'x / ! xyz{|}~ del DATA UP_TBL_2 / 1 '80'x, '81'x, '82'x, '83'x, '84'x, '85'x, '86'x, '87'x, ! 1 '88'x, '89'x, '8A'x, '8B'x, '8C'x, '8D'x, '8E'x, '8F'x, ! 1 '90'x, '91'x, '92'x, '93'x, '94'x, '95'x, '96'x, '97'x, ! 1 '98'x, '99'x, '9A'x, '9B'x, '9C'x, '9D'x, '9E'x, '9F'x, ! 1 'A0'x, 'A1'x, 'A2'x, 'A3'x, 'A4'x, 'A5'x, 'A6'x, 'A7'x, ! 1 'A8'x, 'A9'x, 'AA'x, 'AB'x, 'AC'x, 'AD'x, 'AE'x, 'AF'x, ! 1 'B0'x, 'B1'x, 'B2'x, 'B3'x, 'B4'x, 'B5'x, 'B6'x, 'B7'x, ! 1 'B8'x, 'B9'x, 'BA'x, 'BB'x, 'BC'x, 'BD'x, 'BE'x, 'BF'x, ! 1 'C0'x, 'C1'x, 'C2'x, 'C3'x, 'C4'x, 'C5'x, 'C6'x, 'C7'x, ! 1 'C8'x, 'C9'x, 'CA'x, 'CB'x, 'CC'x, 'CD'x, 'CE'x, 'CF'x, ! 1 'D0'x, 'D1'x, 'D2'x, 'D3'x, 'D4'x, 'D5'x, 'D6'x, 'D7'x, ! 1 'D8'x, 'D9'x, 'DA'x, 'DB'x, 'DC'x, 'DD'x, 'DE'x, 'DF'x, ! 1 'E0'x, 'E1'x, 'E2'x, 'E3'x, 'E4'x, 'E5'x, 'E6'x, 'E7'x, ! 1 'E8'x, 'E9'x, 'EA'x, 'EB'x, 'EC'x, 'ED'x, 'EE'x, 'EF'x, ! 1 'F0'x, 'F1'x, 'F2'x, 'F3'x, 'F4'x, 'F5'x, 'F6'x, 'F7'x, ! 1 'F8'x, 'F9'x, 'FA'x, 'FB'x, 'FC'x, 'FD'x, 'FE'x, 'FF'x / ! C C --------------------------------------------------------------------------- C C Translate the lower case to upper case. C STATUS = LIB$MOVTC( SRC_STR, ' ', UP_TBL, DST_STR ) C C Retrun to the caller. C Q_UPCASE = STATUS RETURN END