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