[Back to STRINGS SWAG index] [Back to Main SWAG index] [Original]
{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ X L A T ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º º
º Case Translation Routines for Turbo/Borland Pascal Strings º
º º
º Version 2.00 º
º º
º Copyright (c) 1995, John O'Harrow F.I.A.P. - All Rights Reserved º
º EMAIL john.oharrow@paradise.org º
º º
º This unit provides a library of very highly optimised routines º
º for the translation of strings into upper/lower case etc. º
º º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
UNIT XLAT;
{================================}INTERFACE{================================}
VAR
Upper, Lower : ARRAY[Char] OF Char;
{These case translation tables are initialised according to the }
{country code information as specified in CONFIG.SYS (DOS 4.0+).}
{For older DOS versions, the 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 important (approx 30% faster). }
{-String Case Conversion Functions------------------------------------------}
FUNCTION Uppercase(CONST S : String) : String;
FUNCTION Lowercase(CONST S : String) : String;
{-General Purpose String Translation Procedure - For ASCII/EBCDIC etc.------}
PROCEDURE Translate(VAR S : String; VAR Table);
{-Inline Macro Conversion Functions-----------------------------------------}
{Exceptionally Fast but Memory Wasteful Inline Translation Procedure}
{(10% Faster than Translate but with overhead of 75 Bytes per Call).}
{**** If anyone knows of a faster procedure, please let me know ****}
PROCEDURE TranslateFast(VAR S : String; VAR Table);
INLINE
($8C/$DE/ {MOV SI,DS }
$5B/$1F/ {POP BX,DS }
$5F/$07/ {POP DI,ES }
$26/$8A/$0D/ {MOV CL,ES:[DI] }
$81/$E1/$FF/$00/ {AND CX,00FFh }
$74/$33/ {JZ @@Done }
$47/ {INC DI }
$F7/$C7/$01/$00/ {TEST DI,1 }
$74/$09/ {JZ @@Even }
$26/$8A/$05/ {MOV AL,ES:[DI] }
$D7/ {XLAT }
$26/$88/$05/ {MOV ES:[DI],AL }
$47/ {INC DI }
$49/ {DEC CX }
{@@Even: }
$D1/$E9/ {SHR CX,1 }
$74/$16/ {JZ @@Last }
$9C/ {PUSHF }
{@@Loop: }
$26/$8B/$05/ {MOV AX,ES:[DI] }
$D7/ {XLAT }
$88/$C2/ {MOV DL,AL }
$88/$E0/ {MOV AL,AH }
$D7/ {XLAT }
$88/$C6/ {MOV DH,AL }
$26/$89/$15/ {MOV ES:[DI],DX }
$83/$C7/$02/ {ADD DI,2 }
$49/ {DEC CX }
$7F/$EC/ {JNZ @@Loop }
$9D/ {POPF }
{@@Last: }
$73/$07/ {JNC @@Done }
$26/$8A/$05/ {MOV AL,ES:[DI] }
$D7/ {XLAT }
$26/$88/$05/ {MOV ES:[DI],AL }
{@@Done }
$8E/$DE); {MOV DS,SI }
{=============================}IMPLEMENTATION{==============================}
{$S-} {Disable Stack Checking to Increase Speed and Reduce Size}
PROCEDURE MakeUppercase(VAR S : String); 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 @@Done {Finished if S is a Null String}
MOV BX,OFFSET Upper {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
INC DI
DEC CX
@@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
MOV DL,AL
MOV AL,AH
XLAT
MOV DH,AL
MOV ES:[DI],DX
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:
END; {MakeUppercase}
PROCEDURE MakeLowercase(VAR S : String); 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 @@Done {Finished if S is a Null String}
MOV BX,OFFSET Lower {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
INC DI
DEC CX
@@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
MOV DL,AL
MOV AL,AH
XLAT
MOV DH,AL
MOV ES:[DI],DX
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:
END; {MakeLowercase}
FUNCTION Uppercase(CONST S : String) : String; ASSEMBLER;
ASM
LES SI,@Result {SS:SI => Result}
LES DI,S {ES:DI => S}
MOV CL,ES:[DI] {Get Length(S)}
MOV SS:[SI],CL
AND CX,00FFh {CX = Length(S), ZF Set if Null String}
JZ @@Done {Finished if S is a Null String}
MOV BX,OFFSET Upper {DS:BX => Translation Table}
INC DI {ES:DI => S[1]}
INC SI
TEST DI,1 {Is ES:DI on a Word Boundary?}
JZ @@Even {Yes - Ok}
MOV AL,ES:[DI] {No - Translate 1st Char}
XLAT
MOV SS:[SI],AL
INC DI
INC SI
DEC CX
@@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
MOV DL,AL
MOV AL,AH
XLAT
MOV DH,AL
MOV SS:[SI],DX
ADD DI,2
ADD SI,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 SS:[SI],AL
@@Done:
END; {Uppercase}
FUNCTION Lowercase(CONST S : String) : String; ASSEMBLER;
ASM
LES SI,@Result {SS:SI => Result}
LES DI,S {ES:DI => S}
MOV CL,ES:[DI] {Get Length(S)}
MOV SS:[SI],CL
AND CX,00FFh {CX = Length(S), ZF Set if Null String}
JZ @@Done {Finished if S is a Null String}
MOV BX,OFFSET Upper {DS:BX => Translation Table}
INC DI {ES:DI => S[1]}
INC SI
TEST DI,1 {Is ES:DI on a Word Boundary?}
JZ @@Even {Yes - Ok}
MOV AL,ES:[DI] {No - Translate 1st Char}
XLAT
MOV SS:[SI],AL
INC DI
INC SI
DEC CX
@@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
MOV DL,AL
MOV AL,AH
XLAT
MOV DH,AL
MOV SS:[SI],DX
ADD DI,2
ADD SI,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 SS:[SI],AL
@@Done:
END; {Lowercase}
PROCEDURE Translate(VAR S : String; VAR Table); 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 SI,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
INC DI
DEC CX
@@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
MOV DL,AL
MOV AL,AH
XLAT
MOV DH,AL
MOV ES:[DI],DX
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,SI {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
MOV SI,Offset Upper
MOV DI,Offset Lower
XOR BX,BX
@@Loop:
MOV [SI+BX],BL
MOV [DI+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.
[Back to STRINGS SWAG index] [Back to Main SWAG index] [Original]