[Back to STRINGS SWAG index] [Back to Main SWAG index] [Original]

    {
       ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ X L A T ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
       º                                                                     º
       º         Case Translation Routines for Turbo/Borland Pascal          º
       º                                                                     º
       º                            Version 1.00                             º
       º                                                                     º
       º  Copyright (c) 1994, John O'Harrow F.I.A.P. - All Rights Reserved   º
       º                                                                     º
       º  This unit provides a library of very highly optimised routines     º
       º  for the translating of strings into upper/lower case.              º
       º                                                                     º
       º  The majority of the routines are coded in assembler, and are       º
       º  contained in the file XLAT.OBJ, which is linked into this unit.    º
       º                                                                     º
       º  The file XLAT.ASM contains the full source code for all of the     º
       º  assembly code routines (This file is designed for assembling with  º
       º  TASM, but may be assembled using MASM with minor modification).    º
       º                                                                     º
       ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼
    }
    {$S-} {Disable Stack Checking to Increase Speed and Reduce Size}

    UNIT XLAT;

    {================================}INTERFACE{================================}

    TYPE
      XlatTable = ARRAY[Char] OF Char;

    VAR
      Upper, Lower : XlatTable;

      {These case translation tables are initialised according to the }
      {country code information as specified in CONFIG.SYS (DOS 4.0+).}
      {For older DOS versions, standard case conversion is used.      }
      {These tables may also be accessed directly using, for example, }
      {ResultChar := Upper['x'].  This provides the fastest possible  }
      {replacement for the standard pascal Upcase() function.         }

    {-String Case Conversion Procedures-----------------------------------------}

      PROCEDURE MakeUppercase(VAR S : String);
      PROCEDURE MakeLowercase(VAR S : String);

      {These procedures should be used in preference to the equivalent}
      {functions below where speed is critical (approx 50% faster).   }

    {-String Case Conversion Functions------------------------------------------}

      FUNCTION  Uppercase(CONST S : String) : String;
      FUNCTION  Lowercase(CONST S : String) : String;

    {-General Purpose String Translation Procedure - ASCII/EBCDIC etc.----------}

      PROCEDURE Translate(VAR S : String; VAR Table : XlatTable);

    {=============================}IMPLEMENTATION{==============================}

    {$L XLAT}

      PROCEDURE MakeUppercase(VAR S : String); EXTERNAL;
      PROCEDURE MakeLowercase(VAR S : String); EXTERNAL;

      FUNCTION  Uppercase(CONST S : String) : String; EXTERNAL;
      FUNCTION  Lowercase(CONST S : String) : String; EXTERNAL;

      PROCEDURE Translate(VAR S : String; VAR Table : XlatTable); ASSEMBLER;
      ASM
        LES   DI,S        {ES:DI => S}
        MOV   CL,ES:[DI]  {Get Length(S)}
        AND   CX,00FFh    {CX = Length(S), ZF Set if Null String}
        JZ    @@Finish    {Finished if S is a Null String}
        MOV   DX,DS       {Save DS}
        LDS   BX,Table    {DS:BX => Translation Table}
        INC   DI          {ES:DI => S[1]}
        TEST  DI,1        {Is ES:DI on a Word Boundary?}
        JZ    @@Even      {Yes - Ok}
        MOV   AL,ES:[DI]  {No  - Translate 1st Char}
        XLAT
        MOV   ES:[DI],AL
        DEC   CX
        INC   DI
      @@Even:             {ES:DI now Alligned on a Word Boundary}
        SHR   CX,1        {CX = Characters Pairs to Translate}
        JZ    @@Last      {Skip if no Character Pairs}
        PUSHF             {Save Carry Flag - Set of Odd Char Left}
      @@Loop:
        MOV   AX,ES:[DI]  {Translate Next 2 Characters}
        XLAT
        XCHG  AL,AH
        XLAT
        XCHG  AL,AH
        MOV   ES:[DI],AX
        ADD   DI,2
        DEC   CX
        JNZ   @@Loop      {Repeat for each Pair of Chars}
        POPF              {Restore Carry Flag}
      @@Last:
        JNC   @@Done      {Finished if No Odd Char to Translate}
        MOV   AL,ES:[DI]  {Translate Last Char}
        XLAT
        MOV   ES:[DI],AL
      @@Done:
        MOV   DS,DX       {Restore Saved DS}
      @@Finish:
      END; {Translate}

    {=Non Interfaced Routines (Used in Unit Initialisation)=====================}

      FUNCTION DosMajorVersion : Byte;
        {-Return DOS Major Version Number}
      INLINE(
        $B4/$30/    {mov ah,$30}
        $CD/$21);   {int $21}

      PROCEDURE SetCountrySpecificUppercase;
        {-Translate 'Upper' into its country specific uppercase equivalent}
      INLINE(
        $BA/>Upper/ {mov dx,Upper}
        $B9/>256/   {mov cx,256}
        $B8/>$6521/ {mov ax,$6521}
        $CD/$21);   {int $21}

      PROCEDURE InitialiseCaseConversion;
      VAR
        C : Char;
      BEGIN
        ASM {Fast/Small Replacement for:- FOR C := #0 TO #255 DO Upper[C] := C;}
          MOV SI,Offset Upper
          XOR BX,BX
        @@Loop:
          MOV [SI+BX],BL
          INC BL
          JNZ @@Loop
        END;
        IF DosMajorVersion < 4 THEN
          FOR C := #0 TO #255 DO
            Upper[C] := System.UpCase(C) {Use Standard Case Conversion}
        ELSE
          SetCountrySpecificUppercase; {Use International Case Conversion}
        FOR C := #255 DOWNTO #0 DO
          IF C <> Upper[C] THEN {Set Lowercase conversion Table from Uppercase}
            Lower[Upper[C]] := C;
      END; {InitialiseCaseConversion}

    {=Unit Initialisation=======================================================}

    BEGIN
      InitialiseCaseConversion;
    END.

    {XLAT.ASM (Cut here and Assemble using TASM) -------------------------------}

              .MODEL TPASCAL

              LOCALS @@

              EXTRN  Upper ;ARRAY[Char] OF Char (Uppercase Translation Table)
              EXTRN  Lower ;ARRAY[Char] OF Char (Lowercase Translation Table)

              .CODE

              .8086

              PUBLIC MakeUppercase, Uppercase
              PUBLIC MakeLowercase, Lowercase

    ;----------------------------------------------------------------------------
    ;PROCEDURE MakeLowercase(VAR S : String);
    ;----------------------------------------------------------------------------
    MakeLowercase PROC FAR
              MOV   AX,Offset Lower  ;Select Case Table
              JMP   SHORT CaseProc
    MakeLowercase ENDP

    ;----------------------------------------------------------------------------
    ;PROCEDURE MakeUppercase(VAR S : String);
    ;----------------------------------------------------------------------------
    MakeUppercase PROC FAR
              MOV   AX,Offset Upper  ;Select Case Table and Drop into CaseProc
    MakeUppercase ENDP

    ;----------------------------------------------------------------------------
    ;Translate String using conversion table at Offset AX in Data Segment
    ;----------------------------------------------------------------------------
    CaseProc  PROC  FAR
              MOV   BX,SP
              LES   DI,SS:[BX+4]     ;ES:DI => String
              MOV   CL,ES:[DI]       ;CL = Length(S)
              AND   CX,00FFh         ;CX = Length(S)
              JZ    @@Done           ;Done if Null String
              MOV   BX,AX            ;DS:BX => Translation Table
              INC   DI               ;ES:DI => S[1]
              JMP   SHORT Translate  ;Exit Via Translate Procedure
    @@Done:   RET   4
    CaseProc  ENDP

    ;----------------------------------------------------------------------------
    ;FUNCTION LowerCase(S : String) : String;
    ;----------------------------------------------------------------------------
    LowerCase PROC  FAR
              MOV   AX,Offset Lower  ;Select Case Table
              JMP   SHORT CaseFunc
    LowerCase ENDP

    ;----------------------------------------------------------------------------
    ;FUNCTION UpperCase(S : String) : String;
    ;----------------------------------------------------------------------------
    UpperCase PROC  FAR
              MOV   AX,Offset Upper  ;Select Case Table and Drop into CaseFunc
    UpperCase ENDP

    ;----------------------------------------------------------------------------
    ;Translate String using conversion table at Offset AX in Data Segment
    ;----------------------------------------------------------------------------
    CaseFunc  PROC  FAR
              MOV   DX,DS            ;Save DS
              MOV   BX,SP
              LDS   SI,SS:[BX+4]     ;DS:SI = String Address
              LES   DI,SS:[BX+8]     ;ES:DI = Result Address
              MOV   BX,AX            ;BX = Offset of Translation Table
              CLD
              LODSB                  ;Get String Length Byte
              STOSB                  ;Store Result Length
              AND   AX,00FFh         ;AX = Length(S)
              JZ    @@Done           ;Exit if Null String
              MOV   CX,AX            ;CX = Length(S)
              PUSH  DI               ;Save Offset of Result[1]
              TEST  DI,1             ;Destination Address Even?
              JZ    @@CWord          ;Yes - Skip Odd Byte Move
              MOVSB                  ;No - Move Odd Byte
              DEC   CX               ;Decrement Count
    @@CWord:  SHR   CX,1             ;CX = Words to Copy, Set CF if Odd Byte Left
              REP   MOVSW            ;Copy CX Words
              JNC   @@Copied         ;Skip if No Odd Byte to Copy
              MOVSB                  ;Copy the Odd Byte
    @@Copied: POP   DI               ;ES:DI => Result[1]
              MOV   DS,DX            ;Restore DS, DS:BX => Translation Table
              MOV   CX,AX            ;CX = String Length
              JMP   SHORT Translate  ;Exit Via Translate Procedure
    @@Done:   RET   4
    CaseFunc  ENDP

    ;----------------------------------------------------------------------------
    ;Translate CX Chars at ES:DI using XLAT Table as DS:BX (Common Exit Proc)
    ;----------------------------------------------------------------------------
    Translate PROC  FAR
              TEST  DI,1             ;Is ES:DI on a Word Boundary?
              JZ    @@Even           ;Yes - Ok
              MOV   AL,ES:[DI]       ;No - Translate 1st Char
              XLAT
              MOV   ES:[DI],AL
              DEC   CX
              INC   DI               ;ES:DI now on a Word Boundary
    @@Even:   SHR   CX,1             ;CX = Characters Pairs to Translate
              JZ    @@Last           ;No Character Pairs
              PUSHF                  ;Save Flags - CF Set of Odd Char Left
    @@Loop:   MOV   AX,ES:[DI]       ;Translate Next 2 Characters
              XLAT
              XCHG  AL,AH
              XLAT
              XCHG  AL,AH
              MOV   ES:[DI],AX
              ADD   DI,2
              DEC   CX
              JNZ   @@Loop           ;Repeat for each Pair of Chars
              POPF                   ;Restore CF
    @@Last:   JNC   @@Done           ;Finished if No Odd Char to Translate
              MOV   AL,ES:[DI]       ;Translate Last Char
              XLAT
              MOV   ES:[DI],AL
    @@Done:   RET   4
    Translate ENDP

    CODE      ENDS
              END

    { --------------------------------------------------------------------- }
    { XX3402 for XLAT.OBJ

      Cut out and name file XLAT.XX.
      Use XX3402 to decode the object file :   xx3402 d xlat.xx
    }

    *XX3402-000403-190296--72--85-07771--------XLAT.OBJ--1-OF--1
    U+c+05VgMLEiEJBBdcUU++++53FpQa7j623nQqJhMalZQW+UJaJmQqZjPW+n9X8NW-++ECa5
    EZAU05VgMLEiEJBBAsU1+21dH7M0++-cW+A+E84IZUM+-2BDF2J3a+Q+86k++U2-eNM4++F2
    EJF-FdU5+2U+++A-+FGA1k+3JJ-EFJ6+-IlDJoJG+2OE3++++EpBEIh3JJ-EFJ71EJB3-E++
    Ut+E+++-0IlDJoJGEo3HFFw++78E2++++EZJI3-3IYB-IoIY++08Y-E+++2BHI39FIlDJoJG
    Eo3HFE+++6i6-+-+cU4Fc7+++E++i+++ukCs++09r1P2TkEaWUq-sTw+R+K9q2TfDQc2+9U+
    +Cg1i+++XBe9r1P3RkEql5w6WxXwf8cZzk-o4Mj6JzT5+E-o+eF7oSbndLA-d3yCqcj6ukD8
    -+1rlk2+R+YaWULL7cU3GITFuLEIb0O9-RS4lBS4l0O7-MD5+YZpvdpn-mO8-RQaW+L8-++F
    b-2+l+3K+gE4JU5263M0l0JK+Na8+U++R+++
    ***** END OF BLOCK 1 *****

[Back to STRINGS SWAG index] [Back to Main SWAG index] [Original]