1;
2; Copyright (C) 1990-1992 Mark Adler, Richard B. Wales, and Jean-loup Gailly.
3; Permission is granted to any individual or institution to use, copy, or
4; redistribute this software so long as all of the original files are included
5; unmodified, that it is not sold for profit, and that this copyright notice
6; is retained.
7;
8; match.asm by Jean-loup Gailly.
9
10; match.asm, optimized version of longest_match() in deflate.c
11; Must be assembled with masm -ml. To be used only with C large model.
12; (For compact model, follow the instructions given below.)
13; This file is only optional. If you don't have masm or tasm, use the
14; C version (add -DNO_ASM to CFLAGS in makefile.msc and remove match.obj
15; from OBJI). If you have reduced WSIZE in zip.h, then change its value
16; below.
17;
18; Turbo C 2.0 does not support static allocation of more than 64K bytes per
19; file, and does not have SS == DS. So TC and BC++ users must use:
20;   tasm -ml -DDYN_ALLOC -DSS_NEQ_DS match;
21;
22; To simplify the code, the option -DDYN_ALLOC is supported for OS/2
23; only if the arrays are guaranteed to have zero offset (allocated by
24; halloc). We also require SS==DS. This is satisfied for MSC but not Turbo C.
25
26        name    match
27
28; define LCODE as follows:
29; model:        compact large (small and medium not supported here)
30; LCODE           0       1
31
32LCODE equ 1
33; Better define them on the command line
34;DYN_ALLOC equ 1
35;SS_NEQ_DS equ 1
36; For Turbo C, define SS_NEQ_DS as 1, but for MSC you can leave it undefined.
37; The code is a little better when SS_NEQ_DS is not defined.
38
39ifndef DYN_ALLOC
40        extrn   _prev         : word
41        extrn   _slide        : byte
42        prev    equ  _prev    ; offset part
43        slide   equ  _slide
44endif
45
46_DATA    segment  word public 'DATA'
47        extrn   _match_start  : word
48        extrn   _prev_length  : word
49        extrn   _good_match   : word
50        extrn   _strstart     : word
51        extrn   _max_chain_length : word
52ifdef DYN_ALLOC
53        extrn   _prev         : word
54        extrn   _slide        : word
55        prev    equ 0         ; offset forced to zero
56        slide   equ 0
57        slide_seg equ _slide[2]
58	slide_off equ 0
59else
60	wseg    dw seg _slide
61        slide_seg equ wseg
62	slide_off equ offset _slide
63endif
64_DATA    ends
65
66DGROUP  group _DATA
67
68if LCODE
69	extrn   _exit : far
70else
71	extrn   _exit : near
72endif
73
74_TEXT   segment word public 'CODE'
75        assume  cs: _TEXT, ds: DGROUP
76
77	public _match_init
78        public _longest_match
79
80	MIN_MATCH     equ 3
81        MAX_MATCH     equ 258
82	WSIZE         equ 8192		; keep in sync with zip.h !
83	WMASK         equ (WSIZE-1)
84	MIN_LOOKAHEAD equ (MAX_MATCH+MIN_MATCH+1)
85	MAX_DIST      equ (WSIZE-MIN_LOOKAHEAD)
86
87prev_ptr    dw  seg _prev		; pointer to the prev array
88ifdef SS_NEQ_DS
89    match_start dw  0			; copy of _match_start if SS != DS
90endif
91
92; initialize or check the variables used in match.asm.
93
94if LCODE
95_match_init proc far
96else
97_match_init proc near
98endif
99ifdef SS_NEQ_DS
100        ma_start equ cs:match_start	; does not work on OS/2
101else
102	assume ss: DGROUP
103        ma_start equ ss:_match_start
104        mov     ax,ds
105        mov     bx,ss
106        cmp     ax,bx                   ; SS == DS?
107        jne     error
108endif
109ifdef DYN_ALLOC
110	mov	ax,_slide[0]		; force zero offset
111	add     ax,15
112	mov     cx,4
113	shr     ax,cl
114	add     _slide[2],ax
115	mov     _slide[0],0
116
117	mov	ax,_prev[0]		; force zero offset
118	add     ax,15
119	mov     cx,4
120	shr     ax,cl
121	add     _prev[2],ax
122	mov     _prev[0],0
123  ifdef SS_NEQ_DS
124	mov	ax,_prev[2]		; segment value
125	mov     cs:prev_ptr,ax		; ugly write to code, crash on OS/2
126        prev_seg  equ cs:prev_ptr
127  else
128        prev_seg  equ ss:_prev[2]	; works on OS/2 if SS == DS
129  endif
130else
131        prev_seg  equ cs:prev_ptr
132endif
133	ret
134error:  call    _exit
135
136_match_init endp
137
138; -----------------------------------------------------------------------
139; Set match_start to the longest match starting at the given string and
140; return its length. Matches shorter or equal to prev_length are discarded,
141; in which case the result is equal to prev_length and match_start is
142; garbage.
143; IN assertions: cur_match is the head of the hash chain for the current
144;   string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1
145
146; int longest_match(cur_match)
147
148if LCODE
149_longest_match  proc far
150else
151_longest_match  proc near
152endif
153        push    bp
154        mov     bp,sp
155        push    di
156	push	si
157	push	ds
158
159if LCODE
160        cur_match    equ word ptr [bp+6]
161else
162        cur_match    equ word ptr [bp+4]
163endif
164;       slide	     equ es:slide (es:0 for DYN_ALLOC)
165;       prev	     equ ds:prev
166;       match        equ es:si
167;       scan         equ es:di
168;       chain_length equ bp
169;       best_len     equ bx
170;       limit        equ dx
171
172	mov	si,cur_match            ; use bp before it is destroyed
173        mov     bp,_max_chain_length    ; chain_length = max_chain_length
174	mov	di,_strstart
175	mov	dx,di
176	sub	dx,MAX_DIST             ; limit = strstart-MAX_DIST
177	jae	limit_ok
178	sub	dx,dx			; limit = NIL
179limit_ok:
180        add     di,2+slide_off          ; di = offset(slide + strstart + 2)
181        mov     bx,_prev_length         ; best_len = prev_length
182	mov     es,slide_seg
183        mov     ax,es:[bx+di-3]         ; ax = scan[best_len-1..best_len]
184        mov     cx,es:[di-2]            ; cx = scan[0..1]
185	cmp	bx,_good_match		; do we have a good match already?
186        mov     ds,prev_seg    		; (does not destroy the flags)
187        assume  ds: nothing
188        jb      do_scan			; good match?
189	shr	bp,1			; chain_length >>= 2
190	shr	bp,1
191        jmp     short do_scan
192
193        even                            ; align destination of branch
194long_loop:
195; at this point, ds:di == scan+2, ds:si == cur_match
196        mov     ax,[bx+di-3]            ; ax = scan[best_len-1..best_len]
197        mov     cx,[di-2]               ; cx = scan[0..1]
198        mov     ds,prev_seg    		; reset ds to address the prev array
199short_loop:
200        dec     bp                      ; --chain_length
201        jz      the_end
202; at this point, di == scan+2, si = cur_match,
203; ax = scan[best_len-1..best_len] and cx = scan[0..1]
204if (WSIZE-32768)
205        and     si,WMASK
206endif
207        shl     si,1                    ; cur_match as word index
208        mov     si,prev[si]             ; cur_match = prev[cur_match]
209        cmp     si,dx			; cur_match <= limit ?
210        jbe     the_end
211do_scan:
212        cmp     ax,word ptr es:slide[bx+si-1] ; check match at best_len-1
213        jne     short_loop
214        cmp     cx,word ptr es:slide[si]      ; check min_match_length match
215        jne     short_loop
216
217        lea     si,slide[si+2]          ; si = match
218        mov     ax,di                   ; ax = scan+2
219        mov     cx,es
220        mov     ds,cx			; ds = es = slide
221        mov     cx,(MAX_MATCH-2)/2      ; scan for at most MAX_MATCH bytes
222        repe    cmpsw                   ; loop until mismatch
223        je      maxmatch                ; match of length MAX_MATCH?
224mismatch:
225        mov     cl,[di-2]               ; mismatch on first or second byte?
226        sub     cl,[si-2]               ; cl = 0 if first bytes equal
227        xchg    ax,di                   ; di = scan+2, ax = end of scan
228        sub     ax,di                   ; ax = len
229	sub	si,ax			; si = cur_match + 2 + offset(slide)
230	sub	si,2+slide_off          ; si = cur_match
231        sub     cl,1                    ; set carry if cl == 0 (can't use DEC)
232        adc     ax,0                    ; ax = carry ? len+1 : len
233        cmp     ax,bx                   ; len > best_len ?
234        jle     long_loop
235        mov     ma_start,si             ; match_start = cur_match
236        mov     bx,ax                   ; bx = best_len = len
237        cmp     ax,MAX_MATCH            ; len >= MAX_MATCH ?
238        jl      long_loop
239the_end:
240	pop	ds
241        assume  ds: DGROUP
242ifdef SS_NEQ_DS
243	mov	ax,ma_start		; garbage if no match found
244	mov	ds:_match_start,ax
245endif
246        pop     si
247        pop     di
248        pop     bp
249        mov     ax,bx                   ; result = ax = best_len
250        ret
251maxmatch:                               ; come here if maximum match
252        cmpsb                           ; increment si and di
253        jmp     mismatch                ; force match_length = MAX_LENGTH
254
255_longest_match  endp
256
257_TEXT   ends
258end
259