home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0000 - 0009 / ibm0000-0009 / ibm0003.tar / ibm0003 / TPOWER53.ZIP / TPASM.ARC / TPCOMP.ASM < prev    next >
Encoding:
Assembly Source File  |  1989-07-10  |  9.0 KB  |  360 lines
  1. ;******************************************************
  2. ;           TPCOMP.ASM 5.07
  3. ;           String handling routines
  4. ;     Copyright (c) TurboPower Software 1987.
  5. ; Portions copyright (c) Sunny Hill Software 1985, 1986
  6. ;     and used under license to    TurboPower Software
  7. ;         All rights reserved.
  8. ;******************************************************
  9.  
  10.     INCLUDE    TPCOMMON.ASM
  11.  
  12. ;******************************************************    Data
  13.  
  14. DATA    SEGMENT    WORD PUBLIC
  15.  
  16.     EXTRN    LetterValues : BYTE    ;Table of letter values
  17.  
  18. DATA    ENDS
  19.  
  20. ;******************************************************    Code
  21.  
  22. CODE    SEGMENT    BYTE PUBLIC
  23.  
  24.     ASSUME    CS:CODE,DS:DATA
  25.  
  26.     PUBLIC    CompString, CompUCString, CompStruct
  27.     PUBLIC    Soundex, MakeLetterSet,    CompareLetterSets
  28.  
  29.     EXTRN    UpCasePrim : FAR
  30.  
  31. Upcase    MACRO                ;UpCase    character in AL
  32.     PUSH    BX
  33.     CALL    UpcasePrim
  34.     POP    BX
  35.     ENDM
  36.  
  37. ;******************************************************    CompString
  38.  
  39. ;  function CompString(s1, s2 :    string)    : CompareType;
  40. ;    {-Return 0, 1, 2 if s1<s2,    s1=s2, or s1>s2}
  41.  
  42. CompString  PROC FAR
  43.  
  44.     StackFrame
  45.     MOV    DX,DS            ;Save DS
  46.     CLD                ;Go forward
  47.  
  48.     LES    DI,SS:[BX+4]        ;ES:DI points to S2
  49.     LDS    SI,SS:[BX+8]        ;DS:SI points to S1
  50.  
  51.     MOV    AH,ES:[DI]        ;AH = Length(S2)
  52.     INC    DI            ;DI points to S2[1]
  53.     LODSB                ;AL = Length(S1)
  54.                     ;SI points to S1[1]
  55.  
  56.     XOR    BX,BX            ;BX holds temporary result
  57.     XOR    CX,CX            ;CX holds count    of chars to compare
  58.  
  59.     MOV    CL,AL            ;Length(S1) in CL
  60.     CMP    AL,AH            ;Compare lengths
  61.     JE    EqLen            ;Lengths equal?
  62.     JB    Comp            ;Jump if S1 shorter than S1
  63.  
  64.     INC    BX            ;S1 longer than    S2
  65.     MOV    CL,AH            ;Length(S2) in CL
  66.  
  67. EqLen:    INC    BX            ;Equal or greater
  68.  
  69. Comp:    JCXZ    Done            ;Done if either    is empty
  70.  
  71.     REPE    CMPSB            ;Compare until no match    or CX =    0
  72.     JE    Done            ;If Equal, result ready    based on length
  73.  
  74.     MOV    BL,2
  75.     JA    Done            ;S1 Greater? Return 2
  76.     XOR    BX,BX            ;Else S1 Less, Return 0
  77.  
  78. Done:    MOV    AX,BX            ;Result    into AX
  79.     MOV    DS,DX            ;Restore DS
  80.     RET    8
  81.  
  82. CompString    ENDP
  83.  
  84. ;******************************************************    CompUCString
  85.  
  86. ;  function CompUCString(s1, s2    : string) : CompareType;
  87. ;    {-Return 0, 1, 2 if s1<s2,    s1=s2, or s1>s2}
  88. ;    {-Comparison is done in uppercase}
  89.  
  90. CompUCString  PROC FAR
  91.  
  92.     StackFrame
  93.     PUSH    DS            ;Save DS
  94.     CLD                ;Go forward
  95.  
  96.     LES    DI,SS:[BX+4]        ;ES:DI points to S2
  97.     LDS    SI,SS:[BX+8]        ;DS:SI points to S1
  98.  
  99.     MOV    AH,ES:[DI]        ;AH = Length(S2)
  100.     INC    DI            ;DI points to S2[1]
  101.     LODSB                ;AL = Length(S1)
  102.                     ;SI points to S1[1]
  103.  
  104.     XOR    BX,BX            ;BX holds temporary result
  105.     XOR    CX,CX            ;CX holds count    of chars to compare
  106.  
  107.     MOV    CL,AL            ;Length(S1) in CL
  108.     CMP    AL,AH            ;Compare lengths
  109.     JE    UcEqLen            ;Lengths equal?
  110.     JB    UcComp            ;Jump if S1 shorter than S1
  111.  
  112.     INC    BX            ;S1 longer than    S2
  113.     MOV    CL,AH            ;Shorter length    in CL
  114.  
  115. UcEqLen: INC    BX            ;Equal or greater
  116.  
  117. UcComp:    JCXZ    UcDone            ;UcDone    if lesser string is empty
  118.  
  119. Start:    LODSB                ;S1[?] into AL
  120.     Upcase                ;convert to upper case
  121.     MOV    AH,ES:[DI]        ;S2[?] into AH
  122.     INC    DI            ;Point ES:DI to    next char in S2
  123.     XCHG    AL,AH
  124.     Upcase                ;convert to upper case
  125.     CMP    AH,AL            ;Compare until no match
  126.     LOOPE    Start
  127.  
  128.     JE    UcDone              ;If Equal, result ready based    on length
  129.  
  130.     MOV    BL,2
  131.     JA    UcDone            ;S1 Greater? Return 2
  132.     XOR    BX,BX            ;Else S1 Less, Return 0
  133.  
  134. UcDone:    MOV    AX,BX            ;Result    into AX
  135.     POP    DS            ;Restore DS
  136.     RET    8
  137.  
  138. CompUCString    ENDP
  139.  
  140.  
  141. ;******************************************************    CompStruct
  142.  
  143. ;  function CompStruct(var s1, s2; size    : word)    : CompareType;
  144. ;    {-Compare two fixed size structures}
  145.  
  146. CompStruct  PROC FAR
  147.  
  148.     StackFrame
  149.     MOV    DX,DS            ;Save DS
  150.     MOV    AX,1            ;BX holds temporary result (Equal)
  151.  
  152.     MOV    CX,SS:[BX+4]        ;Size in CX
  153.     JCXZ    CSDone            ;Make sure size    isn't zero
  154.  
  155.     LES    DI,SS:[BX+6]        ;ES:DI points to S2
  156.     LDS    SI,SS:[BX+10]        ;DS:SI points to S1
  157.     CLD                ;Go forward
  158.  
  159.     REPE    CMPSB            ;Compare until no match    or CX =    0
  160.     JE    CSDone            ;If Equal, result ready    based on length
  161.  
  162.     INC    AX            ;Prepare for Greater
  163.     JA    CSDone            ;S1 Greater? Return 2
  164.     XOR    AX,AX            ;Else S1 Less, Return 0
  165.  
  166. CSDone:    MOV    DS,DX            ;Restore DS
  167.     RET    10
  168.  
  169. CompStruct    ENDP
  170.  
  171. ;******************************************************    Soundex
  172.  
  173. ;  function Soundex(s :    string)    : string;
  174. ;    {-Return 4    character soundex of input string}
  175.  
  176. ;256 byte lookup table ASCII ==> soundex code
  177. SoundExTable label byte
  178.     db     65 dup(0)
  179. ;     A  B    C   D  E  F   G     H I  J      K   L      M   N     O  P    Q   R    S   T  U  V  W    X  Y  Z
  180.     db     0,'1','2','3',0,'1','2',0,0,'2','2','4','5','5',0,'1','2','6','2','3',0,'1',0,'2',0,'2'
  181.     db     6 dup(0)
  182. ;     a  b    c   d  e  f   g     h i  j      k   l      m   n     o  p    q   r    s   t  u  v  w    x  y  z
  183.     db     0,'1','2','3',0,'1','2',0,0,'2','2','4','5','5',0,'1','2','6','2','3',0,'1',0,'2',0,'2'
  184.     db     133 dup(0)
  185.  
  186. ;Parameter and function    result
  187.     Result EQU DWORD PTR [BP+10]
  188.     Input  EQU DWORD PTR [BP+6]
  189.  
  190. Soundex    PROC FAR
  191.  
  192.     StackFrameBP
  193.     PUSH   DS
  194.     CLD
  195.     LES    DI,Result        ;ES:DI => function result
  196.     MOV    AL,4
  197.     STOSB                ;Result    will be    4 characters long
  198.     MOV    BX,DI            ;Store output position in BX
  199.     MOV    AL,'0'            ;Store four '0's in output
  200.     MOV    CX,4
  201.     REP    STOSB            ;Initialize to zeros
  202.     MOV    DI,BX            ;Reset output position
  203.  
  204.     LDS    SI,Input            ;DS:SI => Input    string
  205.     LODSB                ;Length    byte into AL
  206.     MOV    CL,AL            ;Length    into CX
  207.     JCXZ   SXDone            ;We're done if null string
  208.     LODSB                ;Get first character of    input
  209.     UpCase                ;Uppercase it
  210.     STOSB                ;Store first output character
  211.     DEC    CX            ;One input character used
  212.     JCXZ   SXDone            ;Done if one character string
  213.  
  214.     MOV    AH,AL            ;Save previous character
  215.     MOV    DX,0401h            ;DL has    output length, DH max output length
  216.     XOR    BH,BH            ;Prepare BX for    indexing
  217.  
  218. SXNext:
  219.     LODSB                ;Next character    into AL
  220.     MOV    BL,AL            ;Set up    base register
  221.     MOV    AL,CS:SoundexTable[BX]    ;Get soundex code into AL
  222.     OR     AL,AL            ;Null soundex code?
  223.     JZ     SXNoStore        ;Don't store it
  224.     CMP    AH,AL            ;Code same as previous output?
  225.     JZ     SXNoStore        ;Don't store it
  226.     STOSB                ;Store to output
  227.     INC    DL            ;Output    length increased by one
  228.     CMP    DL,DH            ;Check output length
  229.     JAE    SXDone            ;Stop at four chars of output
  230.     MOV    AH,AL            ;Store previous    output character
  231.  
  232. SXNoStore:
  233.     LOOP   SXNext
  234.  
  235. SXDone:
  236.     POP    DS
  237.     ExitCode 4            ;Leave result pointer on stack
  238.  
  239. Soundex    ENDP
  240.  
  241. ;******************************************************    MakeLetterSet
  242.  
  243. ;function MakeLetterSet(S : string) : LongInt;
  244. ;Return    a bit-mapped long storing the individual letters contained in S.
  245.  
  246. MLSstr    EQU    DWORD PTR SS:[BX+4]
  247.  
  248. MakeLetterSet    PROC FAR
  249.  
  250.     StackFrame                ;Set up    stackframe
  251.     PUSH    BP                ;Save BP
  252.     PUSH    DS                ;Save DS
  253.     SetZero    DI                ;DI = 0
  254.     MOV    AX,DI                ;AX = 0
  255.     CLD                    ;Go forward
  256.     LDS    SI,MLSstr            ;DS:SI => string
  257.     LODSB                    ;AX = Length(S)
  258.     MOV    CX,AX                ;CX = Length(S)
  259.     MOV    BX,DI                ;DI:BX = 0
  260.     JCXZ    MLSexit                ;Done if CX is 0
  261.  
  262. MLSnext:
  263.     SetZero    AH                ;AH = 0
  264.     LODSB                    ;AL has    next char in S
  265.     Upcase                    ;Convert to upper case
  266.     SUB    AX,'A'                ;Convert to bit    number
  267.     CMP    AX,'Z'-'A'            ;Was char in range 'A'..'Z'?
  268.     JA    MLSskip                ;Skip it if not
  269.  
  270.     XCHG    CX,AX                ;CX = bit #, AX    = loop count
  271.     SetZero    DX                ;DX:AX = 1
  272.     MOV    BP,1
  273.     JCXZ    MLSnoShift            ;don't shift if CX is 0
  274.  
  275. MLSshift:                    ;DX:BP = 1 shl BitNumber
  276.     SHL    BP,1                ;shift low word
  277.     RCL    DX,1                ;shift high word
  278.     LOOP    MLSshift            ;repeat
  279.  
  280. MLSnoshift:
  281.     OR    DI,DX                ;DI:BX = DI:BX or DX:BP
  282.     OR    BX,BP
  283.     MOV    CX,AX                ;Restore CX from AX
  284.  
  285. MLSskip:
  286.     LOOP    MLSnext                ;Get next character
  287.  
  288. MLSexit:
  289.     MOV    DX,DI                ;DX:AX = DI:BX
  290.     MOV    AX,BX
  291.     POP    DS                ;Restore DS
  292.     POP    BP                ;Restore BP
  293.     RET    4
  294.  
  295. MakeLetterSet    ENDP
  296.  
  297. ;******************************************************    CompareLetterSets
  298.  
  299. ;function CompareLetterSets(Set1, Set2 : LongInt) : Word;
  300. ;Returns the sum of the    values of the letters common to    Set1 and Set2.
  301.  
  302. Set1    EQU    DWORD PTR SS:[BX+4]
  303. Set2Hi    EQU    WORD PTR SS:[BX+10]
  304. Set2Lo    EQU    WORD PTR SS:[BX+8]
  305.  
  306. CompareLetterSets    PROC FAR
  307.  
  308.     StackFrame
  309.     PUSH    BP                ;Save BP
  310.  
  311.     LES    DI,Set1                ;Set1 in ES:DI
  312.     MOV    SI,ES                ;Set1 in SI:DI
  313.     AND    DI,Set2Lo            ;SI:DI = Set1 and Set2
  314.     AND    SI,Set2Hi
  315.  
  316.     SetZero    BP                ;BP = 0
  317.     MOV    CX,('Z'-'A')+1            ;Loop count
  318.  
  319. CLSnext:
  320.     MOV    BX,CX                ;save CX in BX
  321.     SetZero    DX                ;DX:AX = 1
  322.     MOV    AX,1
  323.     SUB    CX,AX                ;subtract 1 to get bit number
  324.     JZ    CLSnoShift            ;don't shift if CX is 0
  325.  
  326. CLSshift:                    ;DX:AX = 1 shl BitNumber
  327.     SHL    AX,1                ;shift low word
  328.     RCL    DX,1                ;shift high word
  329.     LOOP    CLSshift            ;repeat
  330.  
  331. CLSnoshift:
  332.     MOV    CX,BX                ;restore CX from BX
  333.     AND    AX,DI                ;DX:AX = DX:AX and SI:DI
  334.     AND    DX,SI
  335.     OR    AX,DX                ;DX:AX = 0?
  336.     JNZ    CLSadd                ;if not, add letter value
  337.     LOOP    CLSnext                ;else, next element
  338.     JMP    SHORT CLSexit            ;done
  339.  
  340. CLSadd:
  341.     SetZero    AH                ;AX has    value of the letter
  342.     MOV    AX,CX                ;AL = loop count
  343.     DEC    AL                ;convert to index into table
  344.     MOV    BX,Offset LetterValues        ;DS:BX points to LetterValues
  345.     XLAT                    ;AL has    value of the letter
  346.     ADD    BP,AX                ;add to    result
  347.     LOOP    CLSnext                ;next element
  348.  
  349. CLSexit:
  350.     MOV    AX,BP                ;Function result into AX
  351.     POP    BP                ;Restore BP
  352.     RET    8
  353.  
  354. CompareLetterSets    ENDP
  355.  
  356.  
  357. CODE    ENDS
  358.  
  359.     END
  360.