[Back to SORTING SWAG index] [Back to Main SWAG index] [Original]

    (*
    IAN LIN

    > Can someone show me an example of how to properly dispose of a linked list?

    I was just as bad when I started in February. :) Anyhow, use mark and
    release. They're 2 new things I've discovered and love much more than
    dispose or freemem. Use MARK(ram) where VAR RAM:POINTER {an untyped
    pointer}. This will save the state of the heap. NOW, when you are done,
    do this: release(ram) and it's back the way it was. No freemem, no dispose,
    just RELEASE! I REALLY love it. :) Need to allocate and deallocate some
    times in between the beginning and the end? Use more untyped pointers (eg.
    RAM2, RAM3, etc.) and you get the picture. Gotta love it. :) Look for a
    message from me in here about linked list sorting. I wrote an entire
    program that does this (to replace DOS's sort. Mine's faster and can use
    more than 64k RAM). Here it is. Some of it is maybe too hard for you but
    then you can ignore that part and just see how I used mark and release.
    *)

    {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
    {$M 8192, 0, 655360}

    type
      pstring = ^string;
      prec    = ^rec;

      rec     = record
        s : pstring;
        n : prec;
      end;

    Var
      dash   : byte;
      err,
      max, c : word;
      list,
      list2,
      node,
      node2  : prec;
      ram,
      ram2,
      ram3   : pointer;
      tf     : text;
      f      : file;

    procedure dodash;
    begin
      case dash of
        1 : write('-');
        2 : write('\');
        3 : write('|');
        4 : write('/');
      end;
      write(#8, ' ', #8);
      dash := dash mod 4 + 1;
    end;

    procedure TheEnd;
    begin
      writeln('Assassin Technologies, NetRunner.');
      halt(err);
    end;

    procedure showhelp;
    begin
      writeln('Heavy duty sorter. Syntax: NSORT <INFILE> <OUTFILE>.');
      writeln('Exit codes: 0-normal; 1-not enough RAM; 2-can''t open infile;');
      writeln('3-outfile can''t be created');
      halt;
    end;

    procedure noram;
    begin
      release(ram);
      assign(f, paramstr(1));
      writeln('Not enough RAM. ', memavail div 1024, 'k; file: ', filesize(f));
      err := 1;
      halt;
    end;

    procedure newnode(var pntr : prec);
    begin
      if sizeof(prec) > maxavail then
      begin
        close(tf);
        noram;
      end;
      new(pntr);
      dodash;
      pntr^.n := nil;
    end;

    procedure getln(var ln : pstring);
    var
      line : string;
      size : word;
    begin
      readln(tf, line);
      size := succ(length(line));
      if size > maxavail then
        noram;
      getmem(ln, size);
      move(line, ln^, succ(length(line)));
      dodash;
    end;

    begin
      err := 0;
      exitproc := @TheEnd;
      if paramcount = 0 then
        showhelp;
      assign(tf, paramstr(1));
      reset(tf);

      if ioresult <> 0 then
      begin
        writeln('Can''t open "', paramstr(1), '".');
        err := 2;
        halt;
      end;

      mark(ram);
      newnode(list);

      if not eof(tf) then
      begin
        getln(list^.s);
        node := list;

        while not eof(tf) do
        begin
          newnode(node^.n);
          node := node^.n;
          getln(node^.s);
        end;

        close(tf);
        newnode(list2);
        list2^.n := list;
        list := list^.n;
        list2^.n^.n := nil;

        while list <> nil do
        begin
          dodash;
          node  := list;
          list  := list^.n;
          node2 := list2;

          while (node2^.n <> nil) and (node^.s^ > node2^.n^.s^) do
            node2 := node2^.n;

          node^.n  := node2^.n;
          node2^.n := node;
          dodash;
        end;
        list := list2^.n;

        assign(tf, paramstr(2));
        rewrite(tf);
        if ioresult <> 0 then
        begin
          writeln('Can''t create "', paramstr(2), '"');
          err := 3;
        end;

        node := list;
        while node <> nil do
        begin
          writeln(tf, node^.s^);
          node := node^.n;
          dodash;
        end;
        writeln;
        close(tf);
        release(ram);
      end;
    end.

[Back to SORTING SWAG index] [Back to Main SWAG index] [Original]