Betreff: Re: Sorting a linked list
Datum: Wed, 25 Nov 1998 18:13:15 GMT
Von: Robert AH Prins
Foren: comp.lang.pascal.borland
In article <365BFC7C.2932@csolve.net>,
Mike Monett wrote:
> Robert AH Prins wrote:
> > As for the sort
> > procedure, its in assembler, drop me a line if you want me to post it.
>
> If its tooo big to post, could you email me a copy? Thanks!
It's hard to cut it out of the program, because, although it's a HEAPSORT,
it's fairly specific for the purpose of sorting a list in three different
ways on two fields, but given that I've not had any comments about previous
big postings, here it is:
NB: I hate PaScAl case & love global variables...
{*
* Format of the input file is (first column is blank, real file
* contains high-ASCII box chars.
+------+-----+--------+-------+-------+------------+
| Trip | Day | KM | Time | V= | Date |
+------+-----+--------+-------+-------+------------+
| 1 | 1 | 638.2 | 6.36 | 96.7 | 16.06.1980 |
| 1 | 2 | 116.0 | 1.33 | 74.8 | 17.06.1980 |
| 1 | 3 | 190.0 | 2.24 | 79.2 | 20.06.1980 |
| 1 | 4 | 128.0 | 1.58 | 65.1 | 21.06.1980 |
.
.
.
+------+-----+--------+-------+-------+------------+
* DAYFORM is a program to sort the list of totals per day into four
* different orders,
*
* - days in trip order
* - days in distance order
* - days in time order
* - days in velocity order
*
* It prints the result of each sort operation in a multi-columnar
format.
*}
program dayform;
type
l25 = string[25];
l54 = string[54];
l55 = string[55];
l255 = string[255];
sdptr = ^sd_list;
sd_list = record
sd_nxt: sdptr;
km : longint;
time : longint;
v : longint;
line : l55;
end;
_sd_ptr = ^_sd_tab;
_sd_tab = array [0..65520 div sizeof(sdptr) - 1] of sdptr;
const
segfs = $64;
r386 = $66;
movsd = $a566;
stosd = $ab66;
imul_eax_ebx = $c3af0f66;
fs_si_bp_4 = $0476b40f; {lfs si, [bp + 4]}
fastshift = 32;
_ibuf = 8192;
_obuf = 8192;
const
sd_ptr : sdptr = nil;
sd_top : sdptr = nil;
sd_end : sdptr = nil;
sd_tab : _sd_ptr = nil;
ibuf : pointer = nil;
obuf : pointer = nil;
km : longint = 0;
time : longint = 0;
v : longint = 0;
_line : l255 = '';
sd_std : l25 = ^M^J' Days in Trip order ';
sd_km : array[1..14] of char = 'Distance order';
sd_time: array[1..14] of char = 'Time order ';
sd_v : array[1..14] of char = 'Velocity order';
const
_days: integer = 0;
_c_ : array[1..4] of char = 'Cols';
_cols: integer = 4;
_r_ : array[1..4] of char = 'Rows';
_rows: integer = 70;
const __crlf: boolean = false;
const {These are box chars in my program!}
sd_topl: l54 = '
+------+-----+--------+-------+-------+------------+ ';
sd_head: l54 = ' | Trip | Day | KM | Time | V= | Date
| ';
sd_sep : l54 = '
+------+-----+--------+-------+-------+------------+ ';
sd_endl: l54 = '
+------+-----+--------+-------+-------+------------+ ';
var
dayin, dayout: text;
_b, _bl, _c, _col, _i, _icv, _ip, _p, _pages, _r: integer;
tempstring: string[10];
temp : string[15];
print : string[15];
_print : integer absolute print;
ires : longint;
{*
* UPDATE_LIST_POINTERS:
*
* const
* xyz_ptr: xyzptr = nil;
* xyz_top: xyzptr = nil;
* xyz_end: xyzptr = nil;
*
* Called as:
*
* asm
* mov di, offset xyz_ptr
* call update_list_pointers
* end;
*
* Replaces:
*
* if xyz_top = nil then
* xyz_top:= xyz_ptr
* else
* xyz_end^.xyz_nxt:= xyz_ptr;
*
* xyz_end:= xyz_ptr;
*}
procedure update_list_pointers; assembler;
asm
mov dx, di
db r386; mov ax, [di + 4]
db r386; or ax, ax
db r386; mov ax, [di]
jnz @1
db r386; mov [di + 4], ax
jmp @2
@1:
les di, [di + 8]
db r386; mov es:[di], ax
@2:
mov di, dx
db r386; mov [di + 8], ax
end; {update_list_pointers}
procedure core_4_cvi_cvr; assembler;
asm
cld
mov dx, ds
mov es, dx
mov di, offset print
xor bx, bx
lodsb
or al, al
jz @3
mov cl, al
@1:
lodsb
cmp al, " "
je @2
inc bx
mov es:[di + bx], al
@2:
dec cl
jnz @1
@3:
mov ds, dx
mov byte ptr print, bl
end; {core_4_cvi_cvr}
function cvi(var anystring): longint;
begin;
asm
push ds
lds si, anystring
call core_4_cvi_cvr
pop ds
end;
val(print, ires, _icv);
if _icv <> 0 then
ires:= -1;
cvi:= ires;
end; {cvi}
procedure dayprint;
begin
for _p:= 1 to _pages do
begin
if _pages > 1 then
begin
str(_p:2, temp);
_line[0]:= char(_cols * 54 + 2);
move(print[1], _line[_bl], integer(print[0]));
asm
mov di, _ip
mov ax, word ptr temp[1]
mov [di + offset _line], ax
end;
end;
asm
mov ax, _cols
mov _col, ax
mov bx, _rows
imul bx
mov cx, _p
dec cx
imul cx
mov _b, ax
end; {_b:= pred(_p) * _rows * _cols;}
asm
inc cx
cmp cx, _pages
jne @1
neg ax
add ax, _days
add ax, bx
dec ax
cwd
idiv bx
mov _col, ax
@1:
end;
{
if _p = _pages then
_col:= (_days - _b + pred(_rows)) div _rows;
}
write(dayout, _line, ^M^J^M^J);
for _i:= 1 to _col do
write(dayout, sd_topl);
write(dayout, ^M^J);
for _i:= 1 to _col do
write(dayout, sd_head);
write(dayout, ^M^J);
for _i:= 1 to _col do
write(dayout, sd_sep);
write(dayout, ^M^J);
for _r:= 1 to _rows do
begin
__crlf:= false;
for _c:= 1 to _col do
begin
_i:= _r + _b + pred(_c) * _rows;
if _i <= _days then
begin
write(dayout, sd_tab^[_i]^.line);
__crlf:= true;
end;
if _i = succ(_days) then
write(dayout, sd_endl);
end;
if __crlf then
write(dayout, ^M^J);
end;
if (_p <> _pages) then
for _c:= 1 to _cols do
write(dayout, sd_endl);
if (_p = _pages) then
if (_days mod _rows = 0) then
for _c:= 1 to _cols do
write(dayout, sd_endl)
else
for _c:= 1 to pred(_col) do
write(dayout, sd_endl);
write(dayout, ^M^J' '^L);
end;
end; {dayprint}
{*
* Sort the array of totals per day in distance, time or velocity
order
*}
procedure daysort(dtv: char; n: integer; var sd: _sd_ptr);
var
_i, _j, _l, ir: integer;
rra : sdptr;
ready, swap : boolean;
begin
asm
dd fs_si_bp_4 {lfs si, [bp + 4]}
mov ready, false
mov ax, n
mov ir, ax
shr ax, 1 + fastshift
inc ax
mov ax, _l
end;
repeat
if _l > 1 then
asm
mov ax, _l
dec ax
mov _l, ax
shl ax, 2
db segfs; les di, [si]
add di, ax
db r386; mov ax, es:[di]
db r386; mov word ptr rra, ax
end
else
asm
db segfs; les di, [si]
db r386; mov bx, es:[di+4]
mov ax, ir
shl ax, 2
add di, ax
db r386; mov ax, es:[di]
db r386; mov word ptr rra, ax
db r386; mov es:[di], bx
mov ax, ir
dec ax
mov ir, ax
cmp ax, 1
jne @1
db r386; mov ax, word ptr rra
db segfs; les di, [si]
db r386; mov es:[di + 4], ax
mov ready, true
@1:
end;
asm
mov ax, _l
mov _i, ax
shl ax, 1 + fastshift
mov _j, ax
end;
while (not ready) and
(_j <= ir) do
begin
if _j < ir then
asm
mov ax, _j
shl ax, 2
db segfs; les di, [si]
add di, ax
les di, es:[di]
db r386; mov bx, es:[di + offset sd_list.km]
db r386; mov cx, es:[di + offset sd_list.time]
db r386; mov dx, es:[di + offset sd_list.v]
mov ax, _j
inc ax
shl ax, 2
db segfs; les di, [si]
add di, ax
les di, es:[di]
mov al, dtv
cmp al, "D"
jne @t
db r386; cmp bx, es:[di + offset sd_list.km]
jl @i
jne @e
db r386; cmp dx, es:[di + offset sd_list.v]
jge @e
jmp @i
@t:
cmp al, "T"
jne @v
db r386; cmp cx, es:[di + offset sd_list.time]
jl @i
jne @e
db r386; cmp dx, es:[di + offset sd_list.v]
jge @e
jmp @i
@v:
cmp al, "V"
jne @e
db r386; cmp dx, es:[di + offset sd_list.v]
jl @i
jne @e
db r386; cmp bx, es:[di + offset sd_list.km]
jge @e
@i:
inc _j
@e:
end;
asm
mov swap, false
les di, rra
db r386; mov bx, es:[di + offset sd_list.km]
db r386; mov cx, es:[di + offset sd_list.time]
db r386; mov dx, es:[di + offset sd_list.v]
mov ax, _j
shl ax, 2
db segfs; les di, [si]
add di, ax
les di, es:[di]
mov al, dtv
cmp al, "D"
jne @t
db r386; cmp bx, es:[di + offset sd_list.km]
jl @i
jne @e
db r386; cmp dx, es:[di + offset sd_list.v]
jge @e
jmp @i
@t:
cmp al, "T"
jne @v
db r386; cmp cx, es:[di + offset sd_list.time]
jl @i
jne @e
db r386; cmp dx, es:[di + offset sd_list.v]
jge @e
jmp @i
@v:
cmp al, "V"
jne @e
db r386; cmp dx, es:[di + offset sd_list.v]
jl @i
jne @e
db r386; cmp bx, es:[di + offset sd_list.km]
jge @e
@i:
mov swap, true
@e:
cmp swap, false
je @f
mov bx, _j
shl bx, 2
db segfs; les di, [si]
db r386; mov ax, es:[di + bx]
mov bx, _i
shl bx, 2
db r386; mov es:[di + bx], ax
mov ax, _j
mov _i, ax
shl ax, 1 + fastshift
mov _j, ax
jmp @q
@f:
mov ax, ir
inc ax
mov _j, ax
@q:
end;
end;
asm
mov ax, _i
shl ax, 2
db segfs; les di, [si]
add di, ax
db r386; mov ax, word ptr rra
db r386; mov es:[di], ax
end;
until ready;
end; {daysort}
(* Original non-assembler version
--------------------------------------
{*
* Sort an array of integers in ascending order (Heapsort)
*}
procedure daysort(dtv: char; n: integer; var sd: _sd_ptr);
var
_i, _j, _k, _l, ir: integer;
rra: sdptr;
ready, swap : boolean;
begin
ready:= false;
_l := succ(n shr 1);
ir := n;
repeat
if _l > 1 then
begin
dec(_l);
rra:= sd^[_l];
end
else
begin
rra := sd^[ir];
sd^[ir]:= sd^[1];
dec(ir);
if ir = 1 then
begin
sd^[1]:= rra;
ready := true
end;
end;
_i:= _l;
_j:= _l * 2;
while (not ready) and
(_j <= ir) do
begin
if _j < ir then
begin
_k:= succ(_j);
{*
* Look at the code generated by TP in TD for the statements
* below, and you'll understand why I'm using BASM...
*}
case dtv of
'D': if (sd^[_j]^.km < sd^[_k]^.km) or
(sd^[_j]^.km = sd^[_k]^.km) and
(sd^[_j]^.v < sd^[_k]^.v) then
inc(_j);
'T': if (sd^[_j]^.time < sd^[_k]^.time) or
(sd^[_j]^.time = sd^[_k]^.time) and
(sd^[_j]^.v < sd^[_k]^.v) then
inc(_j);
'V': if (sd^[_j]^.v < sd^[_k]^.v) or
(sd^[_j]^.v = sd^[_k]^.v) and
(sd^[_j]^.km < sd^[_k]^.km) then
inc(_j);
end;
end;
swap:= false;
case dtv of
'D': if (rra^.km < sd^[_j]^.km) or
(rra^.km = sd^[_j]^.km) and
(rra^.v < sd^[_j]^.v) then
swap:= true;
'T': if (rra^.time < sd^[_j]^.time) or
(rra^.time = sd^[_j]^.time) and
(rra^.v < sd^[_j]^.v) then
swap:= true;
'V': if (rra^.v < sd^[_j]^.v) or
(rra^.v = sd^[_j]^.v) and
(rra^.km < sd^[_j]^.km) then
swap:= true;
end;
if swap then
begin
sd^[_i]:= sd^[_j];
_i := _j;
_j := _j * 2;
end
else
_j:= succ(ir);
end;
sd^[_i]:= rra;
until ready;
end; {daysort}
----------------------------------------------------------------------*)
begin
asm
mov al, byte ptr _c_ + 3
cmp al, byte ptr _r_ + 3
jne @q
mov ax, _rows
cmp ax, 1
jge @r
mov _rows, 70
@r:
cmp ax, 100
jle @c
mov _rows, 100
@c:
cmp _cols, 1
jl @a
cmp _cols, 4
jle @q
@a:
mov _cols, 4
@q:
end;
getmem(ibuf, _ibuf);
getmem(obuf, _obuf);
assign(dayin, 'DAYS.H-H');
settextbuf(dayin, ibuf^, _ibuf);
reset(dayin);
assign(dayout, 'DAYS.H-C');
settextbuf(dayout, obuf^, _obuf);
rewrite(dayout);
repeat
readln(dayin, _line);
if (_line[4] <> 'T') and
(_line[4] <> '-') then
begin
inc(_days);
{Do you really think I'm using "Copy"...}
asm
db r386; mov ax, word ptr _line[17]
db r386; mov word ptr temp[1], ax
mov al, byte ptr _line[22]
mov byte ptr temp[5], al
mov byte ptr temp[0], 5
end;
km:= cvi(temp);
asm
mov ax, word ptr _line[26]
mov word ptr temp[1], ax
mov byte ptr temp[0], 2
mov ax, word ptr _line[29]
mov word ptr tempstring[1], ax
mov byte ptr tempstring[0], 2
end;
time:= cvi(temp) * 60 + cvi(tempstring);
v := trunc(((km * 60000) / time) * 1000.0);
new(sd_ptr);
asm
les di, sd_ptr
mov cx, type sd_list / 4
db r386; xor ax, ax
cld
rep; dw stosd
mov di, offset sd_ptr
call update_list_pointers
end;
sd_ptr^.km := km;
sd_ptr^.time:= time;
sd_ptr^.v := v;
_line[0] := #54;
_line[54]:= ' ';
sd_ptr^.line:= _line;
end;
until eof(dayin);
_i:= _days * sizeof(sdptr);
getmem(sd_tab, _i);
asm
les di, sd_tab
mov cx, _i
shl cx, 2
db r386; xor ax, ax
cld
rep; dw stosd
end; {filldword(sd_tab^, _i, #0#0#0#0);}
asm
db $0f,$b4,$36; dw offset sd_tab {lfs si, sd_tab}
db r386; mov ax, word ptr sd_top
@1:
db r386; mov word ptr sd_ptr, ax
db r386; or ax, ax
jz @2
add si, 4
db r386; db segfs; mov [si], ax
les di, sd_ptr
db r386; mov ax, es:[di]
jmp @1
@2:
end;
{ Original non-assembler, generated code is hopeless!
sd_ptr:= sd_top;
_i := 1;
repeat
sd_tab^[_i]:= sd_ptr;
inc(_i);
sd_ptr:= sd_ptr^.sd_nxt;
until sd_ptr = nil;
}
_pages:= (((_days + _rows - 1) div _rows) + _cols - 1) div _cols;
if _pages > 1 then
begin
_bl:= _cols * 54 - 11;
_ip:= _bl + 6;
str(_pages, print);
case print[0] of
#1: begin
insert(' Page . of ', print, 0);
end;
#2: begin
dec(_ip);
insert('Page . of ', print, 0);
end;
end;
fillchar(_line, sizeof(_line), ' ');
end;
move(sd_std, _line, sizeof(sd_std));
dayprint;
daysort('D', _days, sd_tab);
move(sd_km, _line[12], sizeof(sd_km));
dayprint;
daysort('T', _days, sd_tab);
move(sd_time, _line[12], sizeof(sd_time));
dayprint;
daysort('V', _days, sd_tab);
move(sd_v, _line[12], sizeof(sd_v));
dayprint;
close(dayin);
close(dayout);
end.
For the other programs that make up my hitch-hiking processing suite, have a
look at http://www.suite101.com/article.cfm/hitch_hiking/11729 (and download
the executables) and if you don't know suite101, have a look at it, IMHO it
is an extremely well designed site!
Robert
--
Robert AH Prins
prinsra@williscorroon.com
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
(
geocities.com/~franzglaser)