How to resolve the algorithm Soundex step by step in the 360 Assembly programming language

Published on 12 May 2024 09:40 PM
#360 assembly

How to resolve the algorithm Soundex step by step in the 360 Assembly programming language

Table of Contents

Problem Statement

Soundex is an algorithm for creating indices for words based on their pronunciation.

The goal is for homophones to be encoded to the same representation so that they can be matched despite minor differences in spelling   (from the   soundex   Wikipedia article). There is a major issue in many of the implementations concerning the separation of two consonants that have the same soundex code! According to the official Rules [[1]]. So check for instance if Ashcraft is coded to A-261.

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Soundex step by step in the 360 Assembly programming language

Source code in the 360 programming language

*        Soundex                   02/04/2017
SOUNDEX  CSECT
         USING  SOUNDEX,R13        base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         LA     R6,1               i=1
       DO WHILE=(C,R6,LE,=A(NTT))  do i=1 to hbound(tt)
         LR     R1,R6                i
         BCTR   R1,0                 -1
         MH     R1,=AL2(L'TT)        *length(tt)
         LA     R4,TT(R1)            @tt(i)
         MVC    S,0(R4)              s=tt(i)
         LA     R1,S                 @s
         LA     R2,L'S               length(s)
LOOP     OI     0(R1),C' '           loop s[l]=ucase(s[l])
         LA     R1,1(R1)               @s++
         BCT    R2,LOOP              endloop
         MVC    CODE,=C'0000'        code='0000'
         MVC    CODE(1),S            code[1]=s[1]
         LA     R8,1                 k=1
         LA     R7,1                 j=1
       DO WHILE=(C,R7,LE,=A(L'S))    do j=1 to length(s)
         LA     R4,S-1                 @s[0]
         AR     R4,R7                  +j
         MVC    CCUR,0(R4)             ccur=s[j]
         TR     CCUR,TABLE             ccur=translate(ccur,table)
       IF C,R7,EQ,=F'1' THEN           if j=1 then
         MVC    CPREV,CCUR               cprev=ccur
       ELSE     ,                      else
*                                        if ccur<>' ' and ccur<>'-'
       IF CLI,CCUR,NE,C' ',AND,CLI,CCUR,NE,C'-',                       *
               AND,CLC,CCUR,NE,CPREV THEN  and ccur<>cprev then
       IF C,R8,LT,=F'4' THEN               if k<4 then
         LA     R8,1(R8)                     k=k+1
         LA     R4,CODE-1(R8)                @code[k]
         MVC    0(1,R4),CCUR                 code[k]=ccur
       ENDIF    ,                          endif
       ENDIF    ,                        endif
       IF CLI,CCUR,NE,C'-' THEN          if ccur<>'-' then
         MVC    CPREV,CCUR                 cprev=ccur
       ENDIF    ,                        endif
       ENDIF    ,                      endif
         LA     R7,1(R7)               j++
       ENDDO    ,                    enddo j
         XDECO  R6,XDEC              edit i
         MVC    PG(2),XDEC+10        i
         MVC    PG+3(L'S),S          s
         MVC    PG+15(L'CODE),CODE   code
         XPRNT  PG,L'PG              print
         LA     R6,1(R6)             i++
       ENDDO    ,                  enddo i
         L      R13,4(0,R13)       restore previous savearea pointer
         LM     R14,R12,12(R13)    restore previous context
         XR     R15,R15            rc=0
         BR     R14                exit
TT       DC     CL12'ashcraft',CL12'ashcroft',CL12'gauss',CL12'ghosh'
         DC     CL12'hilbert',CL12'heilbronn',CL12'lee',CL12'lloyd'
         DC     CL12'moses',CL12'pfister',CL12'robert',CL12'rupert'
         DC     CL12'rubin',CL12'tymczak',CL12'soundex',CL12'example'
TTEND    EQU    *
NTT      EQU    (TTEND-TT)/L'TT    hbound(tt)
S        DS     CL12
CCUR     DS     CL1                current
CPREV    DS     CL1                previous
CODE     DS     CL4
PG       DC     CL80' '
XDEC     DS     CL12
TABLE    DC     CL256' '           translation table
         ORG    TABLE+C'A'
         DC     CL9' 123 12- '     ABCDEFGHI
         ORG    TABLE+C'J'
         DC     CL9'22455 126'     JKLMNOPQR
         ORG    TABLE+C'S'
         DC     CL9'23 1-2 2'      STUVWXYZ
         ORG
         YREGS
         END    SOUNDEX

You may also check:How to resolve the algorithm Hello world/Text step by step in the FOCAL programming language
You may also check:How to resolve the algorithm Loops/Infinite step by step in the HicEst programming language
You may also check:How to resolve the algorithm Simulate input/Keyboard step by step in the Tcl programming language
You may also check:How to resolve the algorithm Command-line arguments step by step in the S-lang programming language
You may also check:How to resolve the algorithm Averages/Arithmetic mean step by step in the Aime programming language