[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]