;*************************** AMUS Program Label ******************************
; Filename: SOUNDX.M68 Date: 3/10/90
; Category: SBR Hash Code: 610-023-046-214 Version: 1.0
; Initials: SMAC Name: BRETT C. CAMMACK
; Company: Telephone #: 4073927012
; Related Files: NONE
; Min. Op. Sys.: Expertise Level: BEG
; Special: SIMPLE, TEST CAREFULLY.
; Description: GENERATES SOUNDEX NUMERICAL CODES FROM TEXT STRING PASSED
;
;
;*****************************************************************************
; XCALL routine to create a SOUNDEX code
;
; History:
; 03/10/90 BCC Written
;
; Donated to the public domain by Brett C. Cammack
;
; Need any XCALL subroutines? Have a new, hot idea? Drop me a line.
;
; Brett C. Cammack
; 415 Cottonwood Place
; Boca Raton, FL 33431
; (407) 392-7012 EST (evenings)
;
; Background:
;
; A soundex code is string of digits that describe an ASCII
; character string by it's pronounced sound. It is useful for
; indexing names, etc. so similar sounding strings may be located
; without regard for spelling.
;
; Acknowledgement:
;
; While I am certain that this concept is published somewhere,
; I would like to thank Thomas Hanlin III for providing the
; source code in 'C' in his library of 'C' routines ADVC10.ARC.
; (available on many PC bulletin boards for downloading)
;
; Usage:
;
; XCALL SOUNDX,text,code
;
; Where:
;
; text - is the ascii text string to be converted (1 to n characters)
;
; code - an ascii character string returning soundex code of text.
; (must be same length as string passed, but code may be
; shorter)
;
BEGIN: CMPW ARGCNT(A3),#2 ; two variables?
JNE BADPAR ; no...
MOVW TXTTYP(A3),D7 ; get text variable type
ANDW #7,D7 ; strip b.s.
CMPW D7,#2 ; string?
JNE BADPAR ; no...
MOVW SDXTYP(A3),D7 ; get code variable type
ANDW #7,D7 ; strip b.s.
CMPW D7,#2 ; string?
JNE BADPAR ; no...
MOVL TXTSIZ(A3),D4 ; size of text string passed
MOVL SDXSIZ(A3),D5 ; size of code string passed
MOVL TXTADR(A3),A2 ; index text passed directly
MOVL SDXADR(A3),A1 ; index code area directly
LEA A0,TABLE ; index conversion table
CLR D2 ; last soundex code digit created
LOOP1: DEC D4 ; pre-decrement count of string size
JMI FINI ; end of string...
TSTB @A2 ; end of string?
JEQ FINI ; yep...
ALF ; is this an alpha character?
BEQ $1 ; yep...
INC A2 ; nope, next character
BR LOOP1 ; start again
$1: CLRB D1
MOVB (A2)+,D1 ; fetch character from text string
CMPB D1,D2 ; match last soundex digit?
BEQ LOOP1 ; yes...
UCS ; convert to upper case
SUBB #'A,D1 ; create offset into table
MOVB 0(A0)[D1],@A1 ; pick digit from table
CMPB D2,@A1 ; same as last code?
BEQ LOOP1 ; yes...
CMPB @A1,#'0 ; a zero?
BEQ LOOP1 ; yes...
MOVB @A1,D2 ; place also in last soundex register
INC A1 ; next position in soundex code string
DEC D5 ; decrement return string size
BPL LOOP1 ; room for more
RTN ; return to BASIC
