home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PCTV3N3.ZIP / FASTLOAD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-10-14  |  6.7 KB  |  182 lines
  1. {*****************************************************************
  2. * A demonstration of how to create and read "memory image" text  *
  3. * files to get faster file loading.                              *
  4. *   (C) Daniel A. Bronstein, Michigan State University, 1991.    *
  5. *   May be freely used and modified provided attribution is made.*
  6. *****************************************************************}
  7. program fastload;
  8. uses
  9.   crt,ptrmath;
  10.  
  11. type
  12.   buffer = array[1..1] of char;
  13.   buffptr = ^buffer;
  14.   strptr = ^string;
  15.   sparray = array[1..1] of strptr;
  16.   sparrptr = ^sparray;
  17.   str12 = string[12];
  18.  
  19. var
  20.   sa : sparrptr;
  21.  
  22. {******************************************************************
  23. * MakeFLF - make a "memory image" fast loading file (fn2) from an *
  24. * ASCII text file (fn1), substituting ts spaces for all tabs.     *
  25. ******************************************************************}
  26. procedure makeFLF(fn1,fn2:string;ts:word);
  27. const
  28.   zip : char = #0;
  29. var
  30.   inf : text;
  31.   outf : file of char;
  32.   s : string;
  33.   tabstr : string[8];              {Arbitrary tab size limit.}
  34.   c,l : word;
  35. begin
  36. {$I-}
  37.   assign(inf,fn1);                 {Open the files.}
  38.   reset(inf);
  39.   if ioresult <> 0 then halt(1);
  40.   assign(outf,fn2);
  41.   rewrite(outf);
  42.   if ioresult <> 0 then halt(1);
  43. {$I+}
  44.   if ts > 8 then ts := 8;          {Create a string to replace tab}
  45.   tabstr[0] := chr(ts);            {characters (#9).}
  46.   fillchar(tabstr[1],ts,' ');
  47.   {Save space at start of file for line count:}
  48.   for c := 1 to sizeof(word) do write(outf,zip);
  49.   l := 0;                                         
  50.   while not eof(inf) do
  51.     begin
  52.       readln(inf,s); inc(l);       {Read line and inc line count,}
  53.       c := pos(#9,s);              {then replace tabs with spaces.}
  54.       while c <> 0 do
  55.         begin
  56.           delete(s,c,1);
  57.           insert(tabstr,s,c);
  58.           c := pos(#9,s);
  59.         end;                 {Write string (including length byte)}
  60.       for c := 0 to ord(s[0]) do write(outf,s[c]);   {to FLF file.}
  61.     end;
  62.   close(inf);
  63.   seek(outf,0);                       {Go back to begining of file}
  64.   zip := chr(lo(l)); write(outf,zip); {and write the line count.}
  65.   zip := chr(hi(l)); write(outf,zip);
  66.   close(outf);
  67. end;
  68.  
  69. {*******************************************************************
  70. * ReadFLF - read the "memory image" fast loading file (fn) into an *
  71. * array of pointers.                                               *
  72. *******************************************************************}
  73. {If you might have more than 32,767 lines, make this a longint:}
  74. function readFLF(fn:str12):integer;
  75. var
  76.   cf : file;
  77.   sp : strptr;
  78.   bp : buffptr;
  79.   sz,fl,l,c,totc : word;
  80.   ovflow,fpos,ccnt : longint;
  81. begin
  82. {$I-}
  83.   assign(cf,fn);                  {Open the FLF file.}
  84.   reset(cf,1);
  85. {$I+}
  86.   if ioresult <> 0 then halt(1);
  87.   ovflow := filesize(cf)-2;       {Save filesize less line count}
  88.   blockread(cf,fl,2);             {and get the line count (fl).}
  89.   if fl > 16380 then fl := 16380; {Largest array space is 1 segment.}
  90.   getmem(sa,fl*sizeof(strptr)); {Get enough memory for fl pointers.}
  91.   l := 0;                       {Init lines created & file position.}
  92.   fpos := 3;                    {Let's be sure to leave some memory}
  93.   if maxavail > $100 then       {for other uses after partial read.}
  94.  
  95.   REPEAT                        {*** Loop start ***}
  96.   {If filesize > largest allocable block..}
  97.   if ovflow > $FFF0 then sz := $FFF0
  98.     else sz := ovflow;          {..use largest allocable.}
  99.   if maxavail < sz then         {If not enough memory for full read}
  100.     sz := maxavail - $100;      {leave some memory for other uses.}
  101.   ovflow := ovflow - sz;        {Determine amount left in file.}
  102.   ccnt := 0;                    {Initialize character counter.}
  103.   getmem(bp,sz);                {Allocate memory for contents,}
  104.   bp := baseptr(bp);            {make sure is in XXXX:000X form,}
  105.   sp := strptr(bp);             {and initialize the string pointer.}
  106.   blockread(cf,bp^,sz,totc);    {BLOCKREAD; totc has actual count.}
  107.  
  108.   {While lines and chars remain: }
  109.   while (l < fl) and (ccnt < totc) do
  110.     begin                       {inc line count, assign strptr to}
  111.       inc(l); sa^[l] := sp;     {array, get length of the string}
  112.       c := succ(ord(sp^[0]));   {inc it and add it to strptr to}
  113.       sp := ptrinc(sp,c);       {get next line location and to}
  114.       ccnt := ccnt + c;         {the character counter.}
  115.     end;
  116.   if ovflow > 0 then            {If not at EOF,}
  117.     begin
  118.       fpos := fpos + ccnt;      {get new file position.}
  119.       if ccnt > totc then       {If didn't read whole of last line,}
  120.         begin                   {abandon the last array pointer}
  121.           dec(l);               {by dec'ing(l), }
  122.           fpos := fpos - c;     {calculate new file start position}
  123.           ovflow := ovflow + c; {and size, and}
  124.           seek(cf,fpos);        {set file there, then loop back.}
  125.         end;
  126.     end;
  127.   UNTIL (l >= fl) or (maxavail <= $100);     {*** Loop end. ***}
  128.   close(cf);
  129.   if l < fl then readFLF := -l else {If only partial read, return a}
  130.     readFLF := l;              {negative line count, else positive.}
  131. end;
  132.  
  133. {*****************************************************************
  134. * ShowFLF - simple-minded, forward only, screen-at-a-time array  *
  135. * viewer showing l lines.                                        *
  136. *****************************************************************}
  137. procedure showFLF(l:word);
  138. var
  139.   a : word;
  140.   k : char;
  141. begin
  142.   a := 1;
  143.   repeat
  144.     clrscr;
  145.     for a := a to a + 23 do
  146.       begin
  147.         if a > l then exit else writeln(sa^[a]^);
  148.       end;
  149.     if a > l then exit else
  150.       write('Q to Quit, any other key for more');
  151.     k := upcase(readkey);
  152.   until (a >= l) or (k = 'Q');
  153. end;
  154.  
  155. {*************************
  156. * FASTLOAD main program. *
  157. *************************}
  158. var
  159.   fn,fn1 : string[12];
  160.   a,b : integer;
  161. begin
  162.   fn := paramstr(1);            {First param is file name, second}
  163.   if paramcount < 2 then a := 5 else   {is tabsize (default = 5).}
  164.     begin
  165.       fn1 := paramstr(2);
  166.       for a := 1 to ord(fn1[0]) do
  167.         if not (fn1[a] in ['0'..'9']) then delete(fn1,a,1);
  168.       val(fn1,a,b);
  169.       if b <> 0 then a := 5;
  170.     end;
  171.   fn1 := fn;
  172.   if pos('.',fn1) <> 0 then            {Create FLF filename.}
  173.     begin
  174.       while fn1[ord(fn1[0])] <> '.' do dec(fn1[0]);
  175.       fn1 := fn1 + 'flf';
  176.     end else fn1 := fn1 + '.flf';
  177.   makeFLF(fn,fn1,a);                   {Make the FLF file,}
  178.   writeln(fn,' read and ',fn1,' created.');
  179.   a := readFLF(fn1);                   {read the FLF file}
  180.   showFLF(abs(a));                     {and display it.}
  181. end.
  182.