IDEAL
         MODEL TPASCAL

STRUC    workarea ; allocated on stack
saveds   DW    ?  ; save area for register DS
xlen     DW    ?  ; length of translated x string
d        DW    ?  ; pointer to beginning of d array on stack
x        DW    ?  ; pointer to beginning of x array on stack
yi       DW    ?  ; current y letter (translated)
dy       DW    ?  ; insert distance for current y letter
ENDS

         CODESEG

         ;     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
dist     db  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1;
         db  1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1; a
         db  1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1; b
         db  1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1; c
         db  1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1; d
         db  1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1; e
         db  1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1; f
         db  1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1; g
         db  1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1; h
         db  1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1; i
         db  1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1; j
         db  1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1; k
         db  1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1; l
         db  1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1; m
         db  1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1; n
         db  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1; o
         db  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1; p
         db  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1; q
         db  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1; r
         db  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1; s
         db  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1; t
         db  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1; u
         db  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1; v
         db  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1; w
         db  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1; x
         db  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1; y
         db  1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0; z

PUBLIC   EditDistance
PROC     EditDistance FAR xadr:DWORD,yadr:DWORD
LOCAL    work:workarea=worklen
         Mov   [work.saveds],DS

; move and translate string x to work area on stack

         Lds   SI,[xadr]
         Mov   DX,SP         ;save SP for computation below
         Dec   DX
         Mov   DI,DX
         Cld
         LodsB
         Or    AL,AL
         Jz    xnull
         Xor   AH,AH
         Mov   CX,AX
         Sub   SP,AX         ;temporarily make room for all of x
         Add   SI,AX
         Dec   SI
         Mov   AX,SS
         Mov   ES,AX
         Std                 ;examine x string backwards

xloop:   LodsB
         Or    AL,20h        ;only alphabetic characters need apply
         Cmp   AL,'a'
         Jl    loopx
         Cmp   AL,'z'
         Jg    loopx
         Sub   AL,60h        ;normalize to 1..26
         StosB
loopx:   Loop  xloop

xnull:   Mov   AX,DX         ;compute length of valid x
         Sub   AX,DI
         Mov   [work.xlen],AX
         Inc   DI
         Mov   [work.x],DI
         Inc   AX            ;d is 2*Succ(Length(x)) long
         Shl   AX,1
         Sub   DI,AX
         Mov   [work.d],DI
         Mov   SP,DI
         Dec   SP

; initialize d array (to first row of conceptual 2d array, dd[i,j])

         Mov   BX,SS
         Mov   ES,BX         ;DI still has [work.d]
         Xor   AX,AX
         Mov   DX,AX
         Cld
         StosW               ;dd[0,0] := 0
         Mov   CX,[work.xlen]
         Or    CX,CX
         Jz    stepd
         Mov   DS,BX
         Mov   SI,[Work.x]
         Mov   BX,AX
iloop:   LodsB               ;for j := 1 to xlen do
         Mov   BL,AL
         Mov   AL,[dist+BX]
         Xor   AH,AH
         Add   AX,DX
         StosW               ;dd[0,j] := dd[0,j-1] + dist[0,x[j]];
         Mov   DX,AX         ;at end of loop, DX = dd[0,xlen]
         Loop  iloop

; step d array down xy plane (d is a row of conceptual array dd[i,j])

stepd:   Lds   SI,[yadr]
         LodsB
         Or    AL,AL
         Jz    done
         Xor   AH,AH
         Mov   CX,AX         ;for i := 1 to Length(y) do begin
         Mov   AX,SS
         Mov   ES,AX

nexty:   LodsB
         Or    AL,20h        ;alpha only
         Cmp   AL,'a'
         Jl    loopy
         Cmp   AL,'z'
         Jg    loopy
         Sub   AL,60h        ;normalize to 1..26,
         Mov   BL,27
         Mul   BL            ;then multiply by 27

         Push  DS            ; save regs and set up for inner loop
         Push  SI
         Push  CX
         Mov   BX,SS
         Mov   DS,BX
         Mov   DI,[work.d]

         Mov   [work.yi],AX  ;yi := y[i];
         Mov   BX,AX
         Xor   AH,AH
         Mov   AL,[dist+BX]
         Mov   [work.dy],AX  ;dy := dist[y[i],0];
         Add   AX,[Word ES:DI]   ;AX := dd[i-1,0] + dy;

         Mov   CX,[work.xlen]    ;for j := 1 to xlen do begin
         Or    CX,CX
         Jz    xdone
         Mov   SI,[work.x]

nextx:   Mov   DX,[ES:DI]    ;DX := dd[i-1,j-1]
         StosW               ;dd[i,j-1] := AX;
         LodsB
         Xor   AH,AH
         Mov   BX,AX
         Mov   AL,[dist+BX]
         Add   AX,[ES:DI-2]  ;AX := dd[i,j-1] + dist[0,x[j]]
         Add   BX,[work.yi]
         Mov   BL,[dist+BX]
         Xor   BH,BH
         Add   DX,BX         ;DX := dd[i-1,j-1] + dist[y[i],x[j]]
         Mov   BX,[ES:DI]
         Add   BX,[work.dy]  ;BX := dd[i-1,j] + dist[y[i],0];
         Cmp   AX,BX         ;AX := Min(AX,BX,DX)
         Jle   skip1
         Mov   AX,BX
skip1:   Cmp   AX,DX
         Jle   skip2
         Mov   AX,DX
skip2:   Loop  nextx

xdone:   StosW
         Pop   CX
         Pop   SI
         Pop   DS
         Mov   DX,AX
loopy:   Loop  nexty

done:    Mov   DS,[work.saveds]
         Mov   AX,DX
         Ret                 ;function result is in AX
ENDP
END