Board index » delphi » single linked lists/'C' system command

single linked lists/'C' system command

Sorry about the empty post.
I would like to know of some coding that would allow me to sort
a single linked list via pointer movement not data movement.
I have a sort that works for a double linked list but I cant seem
to make it work for a single linked list.
Also, in 'C' I have access to a command 'system' that allows me
to run DOS programs from within my program, but I cant seem to find
an equivalent Pascal command, which means I have to break my programs
in two if I have to sort some intermediate work files.
I hope somebody can help me.
thanks
 

Re:single linked lists/'C' system command


Quote
ewatson <exwat...@interhop.net> wrote in message

news:8113o6$c36$1@news.auracom.net...

Quote
> Sorry about the empty post.

Your newsreader software should have an option somewhere to cancel a post.
Good hunting!

Quote
> I would like to know of some coding that would allow me to sort
> a single linked list via pointer movement not data movement.
> I have a sort that works for a double linked list but I cant seem
> to make it work for a single linked list.

The problem is moving the items in the list. Draw it out on paper. In
several steps. It shouldn't be too difficult once you can visualise it,
since you managed it for the doubly-linked list, but you will get your brain
in a twist if you don't have diagrams to work from.

In a singly-linked list your program will have to remember the item pointing
at the item you wish to move, as well as the item before the position you
want to move it to. In a doubly linked list you can tell immediately what
the predecessor of any item is, because each item has references or pointers
to its predecessor and successor, but in a singly-linked list you need to
remember the predecessor from when you were following the list to find the
item to be moved, and have that stored in a variable somewhere.

Quote
> Also, in 'C' I have access to a command 'system' that allows me
> to run DOS programs from within my program, but I cant seem to find
> an equivalent Pascal command

It's called Exec and is in the DOS unit. When trying to use it you must tell
your program not to hog all the memory, by using the {$M directive.

FP

Re:single linked lists/'C' system command


In article <8113o6$c3...@news.auracom.net>,

Quote
ewatson  <exwat...@interhop.net> wrote:
>Sorry about the empty post.
>I would like to know of some coding that would allow me to sort
>a single linked list via pointer movement not data movement.
>I have a sort that works for a double linked list but I cant seem
>to make it work for a single linked list.

Here is one with a complete test program. Make sure that you pass the
correct length or hell breaks loose.

uses dos;

Type pnode=^node;
     node=record
            next:pnode;
            data:word;
          End;

{$f+}
function heapfunc(size:word):integer;
begin
  heapfunc:=1
End;
{$f-}

Function MakeList:pnode;
var p,q:pnode;
    i:longint;
label break;
begin
  q:=nil;
  for i:=1 to 1000000 do begin
    new(p);
    if p=nil then goto break;
    p^.data:=random(65535);
    p^.next:=q;
    q:=p;
  End;

break:
  MakeList:=q;
End;

Function ListLen(p:pnode):longint;
var l:longint;
begin
  l:=0;
  while p<>nil do begin
    inc(l);
    p:=p^.next;
  End;
  listlen:=l;
End;

Function Sum(p:pnode):word;
var s:word;
begin
  s:=0;
  while p<>nil do with p^ do begin
                    s:=s+data;
                    p:=next;
                  End;
  sum:=s;
End;

Function Lshr1(x:longint):longint;
  inline(
         $58/                { POP AX    }
         $5A/                { POP DX    }
         $D1/$EA/            { SHR DX,1  }
         $D1/$D8             { RCR AX,1  }
        );

Procedure SortList(var list:pnode; len:longint);
var p,q,r:pnode;
    i:longint;
Begin
  if len<2 then exit;
  p:=list;
  r:=p;

  { find the last node in the first half list }

  for i:=2 to lshr1(len) do r:=r^.next;

  q:=r^.next;     { get the first nor of the second half list}
  r^.next:=nil;   { cut the list }

  SortList(p,lshr1(len));
  SortList(q,len-lshr1(len));

  if p^.data<=q^.data then begin         { get the first element of the }
                             r:=p;       { combined list }
                             p:=p^.next;
                           end
                      else begin
                             r:=q;
                             q:=q^.next;
                           End;
  list:=r;
  while (p<>nil) and (q<>nil) do         { merge the rest of the lists }
    if p^.data<=q^.data then begin
                               r^.next:=p;
                               r:=p;
                               p:=p^.next;
                             end
                        else begin
                               r^.next:=q;
                               r:=q;
                               q:=q^.next;
                             End;

  if p=nil then r^.next:=q
           else r^.next:=p;
End;

Function testList(p:pnode):boolean;
Begin
  testlist:=false;
  while (p<>nil) and (p^.next<>nil) do begin
    if p^.data>p^.next^.data then exit;
    p:=p^.next;
  End;
  testlist:=true;
End;

function timer:real;
var h,m,s,f:word;
begin
  gettime(h,m,s,f);
  timer:=h*3600.0+m*60.0+s+f/100;
end;

var p:pnode;
    t:real;
    s:word;
    len:longint;

begin
  heaperror:=@heapfunc;
  randomize;
  Writeln('Creating data');
  p:=makelist;
  s:=sum(p);
  len:=listlen(p);
  Writeln('Sorting ',len,' integers');
  t:=timer;
  Sortlist(p,len);
  t:=timer-t;
  Writeln((s=sum(p)) and testlist(p),' ',t:1:2,' seconds');
End.

Quote
>Also, in 'C' I have access to a command 'system' that allows me
>to run DOS programs from within my program, but I cant seem to find
>an equivalent Pascal command, which means I have to break my programs
>in two if I have to sort some intermediate work files.
>I hope somebody can help me.

swapvectors
exec(getenv('compspec'),'/c '+command);
swapvectors

Remember to limit the heap with {$M...

Alternatively you could use the following provided you have enough
unused heap at the top (The unit does no swapping, it just releases
unused heap). Well it even has procedure Shell() whichj is basially same
as system() in C. TP 6.0 minimum required. (and not just because it uses
ASM).

Remember some programs like PRINT can load a TSR portion when first
used. That is a No No when using Exec()

Remember to check the variable Doserror after executing an external program.
You can also use function MaxProg to check how many kilobytes you have
available. If you do not have enough the try to free something. You
might write dynamic data structure to XMS/Disk. Sometimes even
reallocating the data structures helps as it can increase the amount of
free memory at the end of the heap (that is the only thing that counts)

Unit Dheap;

Interface

uses dos;

{$ifdef msdos }

Const execerror:boolean=false; { if set, exit ASAP }

procedure exec(const com,par:string);
Function MaxProg:word;  { kilobytes }

{$endif}

Const freeenv:word=300; { amount of free environment for shell/push }

Procedure Shell(const st:string);
Procedure Push;

Implementation

{$ifdef msdos}

type words=record lo,hi:word; end;

procedure exec(const com,par:string);
var rg:registers;
Begin
  if execerror then begin     { If error is set, then just call dos.exec }
     dos.exec(com,par);       { in general one should exit without using }
     exit;                    { exec when execerror is set }
  End;
  rg.bx:=words(Heapptr).hi-prefixseg+1;
  rg.es:=prefixseg;
  rg.ah:=$4a;
  MsDos(rg);                  { Reduce the memory block }

  dos.exec(com,par);

  rg.bx:=words(HeapEnd).hi-prefixseg;
  rg.es:=prefixseg;
  rg.ah:=$4a;
  MsDos(rg);                  { Restore the memory block }
  if rg.flags and fcarry>0    { Could not reallocate? }
    then begin
           heapend:=heapptr;  { reduce the heap }
           execerror:=true;   { set the errorflag }
         End;
End;

{ Execerror is set if one loads a TSR from exec() }

Function MaxProg:word;  { kilobytes }
var mp:word;
begin
  mp:=words(heapend).hi-words(heapptr).hi;
  if mp>2 then maxprog:=(mp-2) shr 6 else maxprog:=0;
End;

{$endif}

type string11=string[11];

Function Envsize:word; assembler;
         asm
         mov es,prefixseg
         mov es,es:[2ch]
         cld
         xor di,di
         mov cx,es
         jcxz @dos2

         xor ax,ax
         mov cx,65535
@l:      repne scasb
         cmp al,es:[di]    { note al=0 }
         jne @l

         mov ah,30h; int 21h; cmp al,3; jb @dos2    { check dos version }

         add di,3
         mov cx,65535
         xor ax,ax               { The length of the program name }
         cld
         repne scasb
         dec di

@dos2:   mov ax,di
         end;

Function commandparams:string11;
var s:string[7];
begin
  if freeenv>0 then begin
    str(FreeEnv+Envsize,s);
    commandparams:=' /e:'+s;
  End
  else commandparams:='';
End;

Procedure Shell(const st:string);
begin
  swapvectors;
  exec(getenv('comspec'),CommandParams+' /c '+st);
  swapvectors;
end;

Procedure Push;
begin
  swapvectors;
  exec(getenv('comspec'),CommandParams);
  swapvectors;
end;

End.

Re:single linked lists/'C' system command


Quote
Osmo Ronkanen wrote:
> Function MakeList:pnode;
> var p,q:pnode;
>     i:longint;
> label break;
> begin
>   q:=nil;
>   for i:=1 to 1000000 do begin
>     new(p);
>     if p=nil then goto break;
>     p^.data:=random(65535);
>     p^.next:=q;
>     q:=p;
>   End;

> break:
>   MakeList:=q;
> End;

Just curious: why did you not use the break procedure instead of defining a
label called break and jumping to it using goto?

Re:single linked lists/'C' system command


In article <38358A15.76F85...@mail.dotcom.fr>,
Frederic Bonroy  <fbon...@mail.dotcom.fr> wrote:

Quote
>Osmo Ronkanen wrote:

>> Function MakeList:pnode;
>> var p,q:pnode;
>>     i:longint;
>> label break;
>> begin
>>   q:=nil;
>>   for i:=1 to 1000000 do begin
>>     new(p);
>>     if p=nil then goto break;
>>     p^.data:=random(65535);
>>     p^.next:=q;
>>     q:=p;
>>   End;

>> break:
>>   MakeList:=q;
>> End;

>Just curious: why did you not use the break procedure instead of defining a
>label called break and jumping to it using goto?

Because I wanted it to work on earlier versions of TP that did not have
break. I originally used break but then edited it for compatibility.

Osmo

Other Threads