TITLE 'IN MEMORY SHELL-metzner sort'
sbttl 'from KILOBAUD april 1981 p164'
;
remark 'For fixed length records stored in memory
Put no. of records in n1 and m1. The length
of each record is stored at k1, and the starting
address at j1. Start sort by calling location
"entry". To change to descending sort change the
instruction at neq: to DAH.'
;
n1: .word 0 ; number of records
m1: .word 0 ; ..same here
k1: .word 0 ; length of records
j1: .word 0 ; starting address of strings
i1: .word 0 ; ptr
ml1: .word 0 ; ptr
dj1: .word 0 ; ptr
di1: .word 0 ;ptr
;
entry: lhld j1 ; get start address
push h ; ..save
lhld k1 ; get length
push h ; ..it too
div: xra a ; m1=m1/2
lhld m1
mov a,h
rar
mov h,a
mov a,l
rar
mov l,a
shld m1 ; save new m1
;
ora h ; check if done
jnz ndon
pop b ; finished
pop d ; ..so return
ret ; ...now
;
; set k1=n1-m1
;
ndon: xchg ; m1 to de
lhld n1
mov a,l
sub e
mov l,a
mov a,h
sbb d
mov h,a
shld k1
lxi h,1 ; set and save i=j=1
shld j1
shld i1
;
; calc & save addr offset = m1*i1
;
dcr l
pop b ; length of str=i1
push b ; ..put it back
lp1: dad d
dcx b
mov a,b
ora c
jnz lp1
shld ml1
;
xchg ; calc & save d(j), d(i), d(i+m)
pop b
pop h
push h
push b
lp2: shld dj1
shld di1
xchg
dad d
xchg ; HL has d(i), DE has d(i+m)
;
; compare strings and switch
;
cp1: pop b ; len of string=l1
push b
lp3: ldax d ; compare each byte
sub m
jnz neq ; not equal
inx h ; if =, then next byte
inx d
dcx b
mov a,b
ora c
jnz lp3
jmp nsw ; if done, don't switch
;
; change next instruction to jc for descending
;
neq: jnc nsw ; if d(i)<d(i+m) don't switch
;
sw: push b ; switch bytes not equal
mov b,m
ldax d
mov m,a
mov a,b
stax d
inx h
inx d
pop b
dcx b
mov a,b
ora c
jnz sw
;
; strings switched, chk if i1-m1 < 1
;
lhld m1
mov a,h
cma
mov d,a
mov a,l
cma
mov e,a
lhld i1
dad d ; if i1-m1<1 then jump to same as
; ..no switch
jnc nsw
;
; calc new d(i), d(i+m)
;
inx h ; save new i1=i1-m
shld i1
lhld di1 ; old d(i)=new d(i+m)
xchg
lhld ml1 ; address offset
mov a,e ; new d(i)=old d(i)-offset
sub l
mov l,a
mov a,d
sbb h
mov h,a
shld di1 ; save new d(i)
jmp cp1 ; goto compare strings
;
; check for j>k
;
nsw: lhld j1
inx h ; save new j=old j+1
shld j1
shld i1
xchg
lhld k1
mov a,l
sub e
mov a,h
sbb d
jc div ; if j>k goto beginning and
; ..divide m1
;
; calc new d(j), d(i)
;
lhld dj1
pop d
push d
dad d ; new d(j)=old d(j+1)
xchg
lhld ml1
xchg
jmp lp2
;
; that all folks
;
.end entry
