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.

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.

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;