(* Collection of code snippets by Arne Vajhøj *)
(* (from articles on eksperten.dk / vajhoej.dk written sometime between 2004 and now) *)
[inherit('sys$library:pascal$lib_routines', 'sys$library:starlet')]
program Read3(input, output);

type
    string = varying[32767] of char;
    word = [word] 0..65535;

procedure test(fnm : string);

const
  PAGE_SIZE = 8192;
  PAGELET_SIZE = 512;
  DISKBLOCK_SIZE = 512;
  OFFSET = 0;
  SIZE = 1000000000;

function BY2U(n : integer; unit_size : integer) : integer;

begin
  BY2U := (n - 1) div unit_size + 1;
end;

type
  data = packed array [1..SIZE] of char;

var
  myfab : fab$type;
  range : array [1..2] of pointer;
  chan : word;
  stat : integer;
  b : ^data;
  t1, t2 : Cardinal;
  n, ix : integer;

begin
  t1 := Clock;
  myfab.fab$b_bid := FAB$C_BID;
  myfab.fab$b_bln := FAB$C_BLN;
  myfab.fab$l_fna := iaddress(fnm.body);
  myfab.fab$b_fns := fnm.length;
  myfab.fab$l_fop := FAB$M_UFO;
  myfab.fab$b_fac := FAB$M_GET;
  myfab.fab$w_ifi := 0;
  myfab.fab$b_shr := 0;
  myfab.fab$l_nam := 0;
  stat := $open(fab := myfab);
  if not odd(stat) then begin
    writeln('Error opening file');
    halt;
  end;
  range[1] := nil;
  range[2] := nil;
  chan := myfab.fab$l_stv;
  stat := $crmpsc(inadr := range, retadr := range, flags := SEC$M_EXPREG, chan := chan, pagcnt := BY2U(SIZE, PAGELET_SIZE), vbn := BY2U(OFFSET, DISKBLOCK_SIZE));
  if not odd(stat) then begin
    writeln('Error mapping file');
    halt;
  end;
  b := range[1];
  n := 0;
  for ix := 1 to SIZE do begin
    if b^[ix] = chr(10) then begin
      n := n + 1;
    end;
  end;
  writeln(n:1,' lines');
  $deltva(inadr := range);
  $close(fab := myfab);
  t2 := Clock;
  writeln('Read one line at a time : ', (t2 - t1):1, ' ms');
end;

var
  i : integer;
  cmdlin : string;

begin
  lib$get_foreign(resultant_string:=cmdlin.body,resultant_length:=cmdlin.length);
  for i := 1 to 3 do begin
    test(cmdlin);
  end;
end.
