TITLE SOUNDEXA
PAGE ,132
;Author : bp-programs, Kalamazoo, Michigan
;Date: Jan 88, for Clipper Summer 87
;Source Code protected by United States Copyright Law
;Permission given for code to be incorporated in other programs by author
;Syntax: SOUNDEXA(string[,filler])
;The soundex code is useful to look up names where you aren't sure of the
;spelling. Codes for similar sounding names are generally (but NOT always)
;close together. The code has the format LETTER-DIGIT-DIGIT-DIGIT. LETTER is
;simply the upper case first letter of the name. DIGITs are derived from the
;translation table below. Empty positions are NOT translated. If there are
;two or more letters with the same code following each other in the name, only
;ONE code number is used. 'Schmidt' is 'S530', not 'S253' or 'S533'. If there
;are more than three code numbers, the extra ones aren't used. If there are
;fewer, the code is padded with zeros. (But see about FILLER below).
;Soundex ABCDEFGHIJKLMNOPQRSTUVWXYZ
;Translation Table: 123 12 22455 12623 1 2 2
;SOUNDEXA is an assembly language implementation of the soundex code. It
;follows my interpretation of the algorithm found on pages 392/393 of Knuth's
;book 'Sorting and Searching', volume 3 of "The Art of Computer Programming".
;It does NOT return the same code as the soundex routine in examplec.c
;(SOUNDEXC) distributed with Clipper Summer 87 or the Rettig soundex routine
;distributed with Clipper Autumn 86 in extenddb.prg (SOUNDEXD).
;The main differences among the three implementations are listed below.
; SOUNDEXA SOUNDEXC SOUNDEXD
; ---------------------- --------------------- ----------------
;Format A999 A999 A9999
;Dupes Skips ltrs generating Skips identical ltrs Skips duplicate
; the same code which are adjacent in original code numbers even
; immediately adjacent in text if not adjacent in
; original text original text
;Null 1. Null string 1. Null string 1. Null string
;Returns 2. Completely non-alpha 2. Non-alpha/non
; string space characters
; except first char
;Fault 1. Ltrims leading non- 1. Does not trim, uses 1. Does not trim,
;Tolerance alpha characters non-alpha as lead uses any char
; 2. Skips intermediate 2. Aborts with non- 2. Skips inter-
; non-alpha characters alpha/non-space mediate non-
; except first char alpha chars
;Speed 3 secs/5000 repeats 9 secs/5000 repeats 90 secs/5000 repts
;I believe, of course, that SOUNDEXA is the 'best' implementation because
;it's closest to Knuth's algorithm, most fault tolerant, fastest (and also
;smallest, by the way) and the most FLEXIBLE. More about this below.
;Knuth's algorithm uses 0s (character zero) to fill trailing empty slots.
;This makes sense when you're constructing an index, such as
; INDEX ON SOUNDEXA(LASTNAME) TO NAMX
;However, when you're SEEK/LOCATEing with SOUNDEX you generally want to find
;all likely candidates and want to make sure that you don't miss any. You'd
;rather find a few wrong ones than miss a single right one. In that case
;you want to include even partial matches, such as
; LOCATE ALL FOR TRIM(SOUNDEXA(PART_NAME))
;SOUNDEXA allows you to select between two fillers, spaces or '0'. Even
;though zeros are 'standard', I find spaces more flexible and have made them
;the default. By specifying a second argument SOUNDEXA(LASTNAME,FILLER) once,
;you change the state of the routine. If FILLER is a '0' (as a character, not
;a number), all future calls to SOUNDEXA will use zeros for filling. If
;FILLER is any other character (or even a null string), SOUNDEXA will use
;spaces in the future. If there isn't a second argument, SOUNDEXA will use
;what you specified before or the default. If you prefer zeros as the default,
;change the FILLER DB to '0' in the DATASG.
;===================================================
EXTRN __PARINFO:FAR ;Clipper EXTEND routine, tells how many arguments
EXTRN __PARC:FAR ;Clipper EXTEND routine, gets a character argument
EXTRN __RETC:FAR ;Clipper EXTEND routine, returns a character value
SX_LENGTH EQU 4 ;Length of soundex code
DGROUP GROUP DATASG ;Ties this segment to the other data segments
;of Clipper. DS points to this DGROUP when
;we arrive in the assembly routine
DATASG SEGMENT WORD PUBLIC 'DATA' ;All PUBLIC segments with the name DATASG
;will be combined by the linker. All segments
;with the class 'DATA' will be adjacent to
;each other. WORD means that the segment
;starts on an even byte, which can sometimes
;be minutely faster in an 8086/80286 machine.
SOUNDEX DB SX_LENGTH DUP (?) ; Space for SOUNDEX result
DB 00 ; Terminator byte
;Strings in C and Clipper are terminated by a NULL (or NUL or
;NIL, it all means the same thing). There is no length byte
;or word as in BASIC or Turbo Pascal.
FILLER DB ' ' ; Filler byte for padding of SOUNDEX, can be
; space (default) or '0'
; Translate table from UC letters to SOUNDEX codes
; Omitted letters return NULL
; 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
; ' 123 12 22455 12623 1 2 2'
TRANSLATE db 0,'123',0,'12',0,0,'22455',0,'12623',0,'1',0,'2',0,'2'
DATASG ENDS
;==================================================
;==================================================
_PROG SEGMENT BYTE PUBLIC 'CODE' ;All PUBLIC segments with
;the name _PROG will be com-
;bined, all segments with the
;class 'CODE' will be
;adjacent. BYTE means that
;the segments will be aligned
;(stuck together) without any
;padding.
ASSUME CS:_PROG, DS:DGROUP, ES:NOTHING ;This is the way the segment
;registers are set up when we
;arrive here from Clipper.
PUBLIC SOUNDEXA ;Used in linking to Clipper, lets Clipper know
;where this routine is.
SOUNDEXA PROC FAR ;The name of our routine (procedure)
PUSH BP ;The Clipper extend documentation on disk
PUSH DI ;says that we have to save registers
PUSH SI ;BP, DI, SI, ES and DS. We are not
PUSH ES ;disturbing BP, so we may not have to save it.
PUSH DS ;But the Clipper routines __PARINFO, __PARC
;and __RETC may do so, we don't know.
;Ensure null string in case of missing argument or no letters
;We do this by moving a NULL byte in the first place of the
;SOUNDEX code. It will be overwritten if there's no error.
MOV BYTE PTR DGROUP:[SOUNDEX], 0
SUB AX, AX ;Faster and smaller than MOV AX, 0
PUSH AX
CALL __PARINFO ;Find out how many arguments passed
ADD SP, 2 ;Clean up stack. C routines, unlike BASIC
;or Pascal do NOT clean up the stack.
CMP AX, 1 ;Is there 1 argument?
JE MAIN_ROUT ;Yes, use stored filler for conversion
CMP AX, 2 ;Are there two arguments?
JNE LEAV ;No, an invalid number of arguments. Leave.
;Two arguments, get the second one - a new FILLER
PUSH AX ;AX is always 2 here
CALL __PARC ;Get the address of FILLER string
ADD SP, 2 ;DX:AX hold pointer to string
MOV ES, DX
MOV BX, AX ;Use ES:BX to point to FILLER string
MOV AL, ' ' ;Load default space character
CMP BYTE PTR ES:[BX], '0' ;Is the new FILLER a '0'?
JNE SX010 ;No, all set with space
MOV AL, '0' ;Yes, make it a '0'
SX010: MOV DGROUP:FILLER, AL ;Set Filler character
MOV AX, 1
;AX is always 1 here, either set above or CMP AX, 1
;Pointer to string in DX:AX (SEG:OFS) for Clipper S87
MAIN_ROUT: PUSH AX
CALL __PARC ;Get pointer to string to convert
ADD SP, 2 ;Pointer to string returned in DX:AX (SEG:OFS)
;Set up pointer registers, seg and ofs
;DS:SI - String to convert, pointer incrementing
;ES:DI - SOUNDEX code in DGROUP, pointer incrementing
;ES:BX - TRANSLATE in DGROUP, points always to base
PUSH DS
POP ES ;ES now points to DGROUP
MOV DS, DX ;And DS to where ever Clipper stores
;its string arguments.
MOV SI, AX ;DS:SI point to start of string to convert
MOV DI, OFFSET DGROUP:SOUNDEX ;ES:DI point to start of
;SOUNDEX
MOV BX, OFFSET DGROUP:TRANSLATE ;ES:BX point to TRANSLATE base
CLD ;Work upward in string instructions
ASSUME DS:NOTHING, ES:DGROUP
;Let MASM know that we've switched seg regs around
MOV CX, SX_LENGTH ;Maximum SOUNDEX length
FIRST_LTR: LODSB ;Get start byte from string to convert
OR AL, AL ;At end of string to convert?
JZ LEAV ;NULL string or no letters anywhere in
;string, return a NULL string
; Real chararacter here, but is it a letter?
AND AL, 0DFH ;This converts letters to upper case,
;destroys other characters. But since
;we don't care about those, it's ok.
MOV AH, AL ;Save the possible starting letter
SUB AL, 'A' ;Subtract the ASCII value of A which
;is 65. This makes A 0, B 1, C 2 etc.
JS FIRST_LTR ;Negative, so not a letter, try again
CMP AL, 'Z' - 'A' ;ASCII Z minus ASCII A is the largest
;real letter value.
JA FIRST_LTR ;Not a letter either, try again
;We found a valid UC starting letter. It's both in AH and AL
XLAT DGROUP:TRANSLATE ;Convert to SOUNDEX code 1-6 or NULL
;XLAT adds the value in AL to BX and
;fetches the character pointed to by
;(normally) DS:BX+AL. Since in this
;case DS points the NOTHING and ES to
;DGROUP, MASM is smart enough to make
;a segment override so that XLAT gets
;the byte at ES:BX+AL and puts it in
;AL. (Replacing the original pointer)
XCHG AH, AL ;After switch, AH holds code,
;AL the UC starting letter
STOSB ;Put first letter into SOUNDEX
LOOP DIGITS ;Decrement CX and jump to actual
;digit conversion. Skip over one
;piece of code.
ERR_DIGITS: SUB AH, AH ;Jump to here only when looping back
;and we want to clear out false
;'previous' letter matches if
;there are non-letters in between.
DIGITS: LODSB ;Get the next character
OR AL, AL ;ORing a value is the fastest way to
;find out if it's NULL (end of string)
JZ ALL_DONE ;Trailing NULL detected
;Not at end of string to convert
AND AL, 0DFH ;Convert to UC
SUB AL, 'A' ;Subtract ASCII 'A'
JS ERR_DIGITS ;Negative, not a letter
;Clear out previous code in AH
CMP AL, 'Z' - 'A'
JA ERR_DIGITS ;Not a letter either, clear previous
;code in AH
;Valid UC letter in AL, 'previous' code in AH
XLAT DGROUP:TRANSLATE ;Convert to SOUNDEX code or NULL
CMP AH, AL ;Same code as previous letter?
JE DIGITS ;Yes, duplicate, don't add to SOUNDEX
;New code, not a duplicate
MOV AH, AL ;Save it as the new 'previous' code
OR AL, AL ;Is it a real or a null code?
JZ DIGITS ;Null code, don't add to SOUNDEX
;Valid code in AL, not the same as previous, add to SOUNDEX
STOSB
LOOP DIGITS ;Continue until SX_LENGTH in SOUNDEX
ALL_DONE: JCXZ LEAV ;Complete soundex, CX counted down
MOV AL, DGROUP:[FILLER] ; ' ' or '0'
REP STOSB ;Fill remainder of SOUNDEX with FILLER
LEAV: POP DS ;Restore DGROUP segment into DS
;Clipper routines, such as __RETC
;expect DS to be pointing to DGROUP
PUSH DS ;Push segment of SOUNDEX string
MOV AX, OFFSET DGROUP:SOUNDEX
PUSH AX ;And push the offset of SOUNDEX
CALL __RETC ;Return pointer to SOUNDEX to Clipper
ADD SP, 4 ;Clean up stack
;DS already popped above
POP ES ;Get remainder of saved registers back
POP SI
POP DI
POP BP
RET ;Go back to Clipper
SOUNDEXA ENDP
_PROG ENDS
END
