%% ``The contents of this file are subject to the Erlang Public License,
%% Version 1.0, (the "License"); you may not use this file except in
%% compliance with the License. You may obtain a copy of the License at
%% http://www.erlang.org/EPL1_0.txt
%% 
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%% 
%% The Original Code is Erlang-4.7.3, December, 1998.
%% 
%% The Initial Developer of the Original Code is Ericsson Telecom
%% AB. Portions created by Ericsson are Copyright (C), 1998, Ericsson
%% Telecom AB. All Rights Reserved.
%% 
%% Contributor(s): ______________________________________.''
%%
%%% File    : dets.erl
%%% Author  : Claes Wikstrom <klacke@erix.ericsson.se>
%%% Purpose : Disc based linear hashing lookup dict
%%% Created : 13 Sep 1996 by Claes Wikstrom <klacke@erix.ericsson.se>

-module(dets).
-copyright('Copyright (c) 1991-97 Ericsson Telecom AB').
-vsn('$Revision: /main/release/free/2').
-author('klacke@erix.ericsson.se').
-export([all/0,
	 close/1,
	 delete/2,
	 delete_object/2,
	 do_match/2,
	 file_info/1,
	 first/1,
	 fixtable/2,
	 fsck/1,
	 get_head_field/2,
	 info/1,
	 info/2,
	 init/1,
	 insert/2,
	 inspect_chain/2,
	 istart_link/0,
	 lookup/2,
	 match/2,
	 match_delete/2,
	 match_object/2,
	 next/2,
	 open_file/1,
	 open_file/2,
	 slot/2,
	 start/0,
	 start_link/0,
	 stop/0,
	 sync/1,
	 traverse/2,
	 update_counter/3,
	 verbose/0,
	 verbose/1
	]).

-export([system_continue/3, system_terminate/4, system_code_change/4]).

-export([is_var/1]).

%% internal
-export([loop0/0, 
	 do_open_file/2,
	 do_open_file/9,
	 view/1]).

%% state for the dets server
-record(state,{store,parent}).

-define(HEADSZ, 40). %% number of bytes before the segm pointer array
-define(FREE, 16#3abcdef).  %% status fields
-define(FREE_AS_LIST, [3,171,205,239]).
-define(ACTIVE, 16#12345678). %% == i32(?ACTIVE_AS_LIST)
-define(A1, 18). 
-define(A2, 52).
-define(A3, 86).
-define(A4, 120).
-define(ACTIVE_AS_LIST, [?A1,?A2,?A3,?A4]).
-define(MAGIC, 16#0abcdef).   %% dets magic, won't ever change
-define(FILE_FORMAT_VERSION, 8). %% 6 in the R1A release
-define(CAN_BUMP_BY_REPAIR, [6, 7]).
-define(SET, 1).
-define(BAG, 2).
-define(DUPLICATE_BAG, 3).
-define(BIG, 16#ffffff).
-define(TRAILER, [88, 99, 111, 177]).  %% just a random seq	

-define(int32(Int), ([(Int bsr 24) band 255,
		      (Int bsr 16) band 255,
		      (Int bsr  8) band 255,
		      Int band 255])).


%% defines for the buddy allocator
-define(MAXBUD, 32).  %% 4 Gig is maxfile size
-define(BASE, (?HEADSZ +  (4 * (?SEGSZ + ?SEGARRSZ)))).
-define(ZERO, [0,0,0,0]).
-define(POW(X), (1 bsl X)).


%% Record for the head structure in a file
%% these records are held in RAM by the server

-record(head,  {
	  m,               %% size
	  next,            %% next position for growth (segm mgmt only)
	  fptr,            %% the file descriptor
	  no_items,        %% number of objects in table,
	  n,               %% split indicator
	  type,            %% set | bag | duplicate_bag
	  keypos,          %% default is 1 as for ets
	  ets,             %% local ets table used to hold the freelist
	  fixed = false    %% fixed table ?
	 }).

-record(info, {    
	  filename,             %% anme of the file being used
	  access = read_write,  %% acces rights = (read | read_write)
	  ram_file = false,     %% true | false
	  name}).               %% the actual Name of the table

%% Assuming that each of these record fields occupy one word
%% This fileheader represents the head of a dets file on the
%% actual file.

-record(fileheader, {
	  freelist,
	  cookie,
	  closed_properly,
	  type,
	  version,
	  m,
	  next,
	  keypos,
	  no_items,
	  trailer,
	  eof,
	  n}).


%% Hardcoded positions right into the head field
-define(FREELIST_POS, 0).
-define(CLOSED_PROPERLY_POS, 8).
-define(D_POS, 20).
-define(CHAIN_LEN, 1).  %% medium chain len
-define(SEGSZ, 256).  %% size of each segment in words  
-define(SEGARRSZ, 8192).  %% max # segments


%%efine(TRACE(X, Y), io:format(X, Y)).
-define(TRACE(X, Y), true).

%%  This is the implementation of the mnesia file storage
%%  Each (non ram-copies) table is maintained in a corresponding
%%  .DAT file. The dat file is organized as a segmented linear
%%  hashlist. The head of the file with the split indicator,
%%  size etc is held in ram by the server at all times.

%%  The actual layout of the file is :
%%   bytes   decsription
%%  ----------------------
%%    4      FreelistPointer
%%    4      Cookie
%%    4      ClosedProperly
%%    4      Type
%%    4      Version
%%    4      M
%%    4      Next
%%    4      KeyPos
%%    4      No_items
%%    4      N
%%  ------------------ end of header
%%    8192  SegmentArray 
%%  ------------------
%%    256  First Segment
%%  -----------------------------
%%    ???   Objects (Free and alive)
%%    256  Second Segment
%%    ???   Objects (Free and alive)
%%    .................

%%  The first word/slot in the segment array, then always has the
%%  value Headsize + 256
%%  Before we can find an object we must find the slot where the
%%  object resides. Each slot is a (possibly empty) list of
%%  objects that hash to the same slot. If the slot is 0, the slot chain
%%  is empty. If the slot is /= 0, the value points to a position
%%  in the file where a chain starts. Each object in a chain has the
%%  following layout:
%%  --------------------
%%    4     Next pointer
%%    4     Size
%%    4     Status  (FREE | ACTIVE)
%%    ??    Binary representing the object

%% We use the STATUS field for 2 different reason.
%%  1. Fast load, we can chunk read a file and just pick out
%%     the real objects from the ones on the freelist
%%  2. Emergency repair/recovery

%%  The freelist is a list with the same layout as the chain
%%  lists except that the status field is FREE on all objects there

%%  The method of hashing is the so called linear hashing algorithm
%%  with segments. 

%%|---------------|
%%|      head     |
%%|       	  |
%%|               |
%%|_______________|
%%|		  |------|
%%|___seg ptr1____|      |
%%|		  |      |
%%|__ seg ptr 2___|      |
%%|               |      |    segment 1
%%|	....	  |      V _____________
%%			 |		|
%%			 |		|
%%			 |___slot 0 ____|
%%                       |              |
%%                       |___slot 1 ____|-----|
%%			 |		|     |
%%			 |   .....	|     |  1:st obj in slot 1
%%					      V  segment 1
%%						|-----------|
%%						|  next     |
%%						|___________|
%%						|  size     |
%%						|___________|
%%						|  status   |
%%						|___________|
%%						|	    |
%%						|           |
%%						|   obj     |
%%						|           |

%% **************** Linear Hashing: *****************
%%  grows linearly
%%  
%%         - n indicates next bucket to split (initially zero); 
%%         - m is the initial size of the hash table 
%%  
%%         - to insert: 
%%                - hash = key mod m 
%%                - if hash < n then hash = key mod 2m 
%%                - if a collision occurs on the initial hash, resolve it 
%%                  by chaining, then split bucket n 
%%                      - add a new bucket to the end of the table 
%%                      - redistribute the contents of bucket n 
%%                        using hash = key mod 2m 
%%                      - increment n 
%%                      - if n = m then m = 2m, n = 0 
%%         - to search: 
%%                hash = key mod m 
%%                if hash < n then hash = key mod 2m 
%%                do linear scan of the bucket 
%%  
%%  
%%  


%% Given, a slot, return the {Pos, Chain} in the file
%% where the objects hashed to this slot resides.
%% Pos is the position in the file where the chain pointer is
%% written and Chain is the position in the file where the chain begins.

chain(Head, Slot) ->
    Pos = ?HEADSZ + (4 * (Slot div ?SEGSZ)),
    F = Head#head.fptr,
    Segment = pread_4(F, Pos),
    FinalPos = Segment + (4 * (Slot rem ?SEGSZ)),
    {FinalPos, pread_4(F, FinalPos)}.


%% Read the {Next, Size} field from the file
%% assuming the file points to a real object
read_8(File) ->
    {ok,  Bin} = file:read(File, 8),
    [N1,N2,N3,N4, S1,S2,S3,S4] = binary_to_list(Bin),
    {i32(N1,N2,N3,N4), i32(S1,S2,S3,S4)}.

pread_4(File, Pos) ->
    {ok, Bin} = file:pread(File, Pos, 4), 
    [X1,X2,X3,X4] = binary_to_list(Bin),
    (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4.

read_4(File) ->
    {ok, Bin} = file:read(File, 4), 
    [X1,X2,X3,X4] = binary_to_list(Bin),
    (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4.

pread_12(F, Pos) ->  %% check for possible eof here
    case file:pread(F, Pos, 12) of
	{ok, Bin} when size(Bin) == 12 ->
	    list_to_tuple(bin2ints(Bin));
	_ ->
	    eof
    end.

get_head_field(File, Field) ->
    {ok, _} = file:position(File, Field),
    read_4(File).

%% Open an already existing file, no arguments
fopen(Fname) ->
    case file:open(Fname, [binary, raw, read, write]) of
	{ok, F} ->
	    case read_head(F, Fname, read_write) of
		{error, not_closed} ->
		    file:close(F),
		    io:format(user,"dets: file ~p not properly closed, "
			      "reparing ...~n",[Fname]),

		    case fsck(Fname) of
			{error, Reason} ->
			    {error, Reason};
			ok ->
			    fopen(Fname)
		    end;
		{ok, Head, Info} ->
		    file:close(F),
		    fopen(make_ref(), Fname, Head#head.type, 
			  Head#head.keypos, false, default, false, read_write);
		Other ->
		    file:close(F),
		    err(open_file, Other)
	    end;
	Other ->
	    Other
    end.

access(read) ->
    [raw, binary, read];
access(read_write) ->
    [raw, binary, read, write].


%% Open and possibly create and initialize a file

fopen(Tab, Fname, Type, Kp, Rep, Est, Ram, Acc) ->
    case catch fopen2(Tab, Fname, Type, Kp, Rep, Est, Ram, Acc) of
	{'EXIT', Reason} -> err(open_file, Reason);
	Other -> Other
    end.

fopen2(Tab, Fname, Type, Kp, Rep, Est, Ram, Acc) ->
    case exists(Fname) of
	yes when Ram == false ->
	    case file:open(Fname, access(Acc)) of
		{ok, Fd} ->
		    fopen_existing_file(Fd, Tab, Fname, Type, Kp, Rep, Est, Ram, Acc);
		{error, Reason} ->
		    err(open_file, Reason)
	    end;
	yes when Ram == true ->
	    {ok, B} = file:read_file(Fname),
	    case ram_file:open(B, access(Acc)) of
		{ok, Fd} -> 
		    fopen_existing_file(Fd, Tab, Fname, Type, Kp, Rep, Est, Ram, Acc);
		{error, Reason} ->  %% Can this fail ??
		    err(open_file, Reason)
	    end;
	no when Ram ==true ->
	    case ram_file:open([], access(Acc)) of
		{ok, Fd} ->
		    fopen_init_file(Fd, Tab, Fname, Type, Kp, Est, Ram, Acc);
		{error, Reason} ->
		    err(open_file, Reason)
	    end;
	no when Ram == false ->
	    case file:open(Fname,access(Acc)) of
		{ok, Fd} ->
		    fopen_init_file(Fd, Tab, Fname, Type, Kp, Est, Ram, Acc);
		{error, Reason} ->
		    err(open_file, Reason)
	    end
    end.


fopen_existing_file(F, Tab, Fname, Type, Kp, Rep, Est, Ram, Acc) ->
    case read_head(F, Fname, Acc) of
	{error, Reason} when Acc == read ->
	    file:close(F),
	    err(open_file, Reason);
	{error, not_closed} when Rep == true   ->
	    %% Gotta repair the file
	    file:close(F),
	    io:format(user,"dets: file ~p not properly "
		      "closed, "
		      "reparing ...~n",[Tab]),
	    case fsck(Tab, Type, Kp, Fname, 8) of
		{error, R} -> 
		    {error, R};
		ok ->
		    fopen(Tab, Fname, Type, Kp, false, Est, Ram, Acc)
	    end;
	{error, version_bump} when Rep == true ->
	    io:format(user,"dets: file ~p old version, "
		      "upgrading ...~n",[Tab]),
	    file:close(F),
	    case fsck(Tab, Type, Kp, Fname, 1) of
		{error, R} -> 
		    {error, R};
		ok ->
		    fopen(Tab, Fname, Type, Kp, false, Est, Ram, Acc)
	    end;
	{error, not_closed} when Rep == false ->
	    file:close(F),
	    err(open_file, need_repair);
	{ok, Head, Info} ->
	    if
		Head#head.type == Type,
		Head#head.keypos == Kp ->
		    Info2=Info#info{name = Tab, 
				    ram_file = Ram},
		    Fd = Head#head.fptr,
		    Ftab = init_freelist(Fd, trunc),
		    {ok, Head#head{ets=Ftab}, Info2};
		true ->
		    file:close(F),
		    err(open_file, wrong_type_or_keypos)
	    end;
	Other -> 
	    err(open_file, Other)
    end.


init_more_segments(Ftab, F, SegNo, Factor) when SegNo < Factor ->
    Segm = alloc(Ftab, 4 * ?SEGSZ),
    {ok, _} = file:position(F, Segm),
    zero(F, ?SEGSZ),
    ok = file:pwrite(F,  ?HEADSZ + (4 * SegNo),  ?int32(Segm)),
    init_more_segments(Ftab, F, SegNo+1, Factor);
init_more_segments(Ftab, F, SegNo, Factor) ->
    ok.


fopen_init_file(F, Tab, Fname, Type, Kp, Est, Ram, read_write) ->
    Factor = if Est == default -> 1;
		true           -> 1 + (Est div ?SEGSZ)
	     end,
    file:truncate(F),
    Freelist = 0,
    Cookie = ?MAGIC,
    Version = ?FILE_FORMAT_VERSION,
    ClosedProperly = 1,
    N = 0,
    M = ?SEGSZ * Factor,
    NoItems = 0,
    Next = ?SEGSZ * Factor,
    ok = file:pwrite(F, 0, [?int32(Freelist),
			    ?int32(Cookie),
			    ?int32(ClosedProperly),
			    ?int32(tt(Type)),
			    ?int32(Version),
			    ?int32(M),
			    ?int32(Next),
			    ?int32(Kp),
			    ?int32(NoItems),
			    ?int32(N)]),

    %% That was the header, 

    Ftab = init_alloc(), %% init allocator


    %%now we need to init
    %% the segment pointer array,
    {ok, _} = file:position(F, ?HEADSZ),
    zero(F, ?SEGARRSZ),
    %% We also need to initialize the first segement
    zero(F, ?SEGSZ),
    %% and we must set the first slot of the
    %% segment pointer array to point to the first
    %% segment

    ok = file:pwrite(F, ?HEADSZ,?int32(?HEADSZ + (4 * ?SEGARRSZ))), 

    init_more_segments(Ftab, F, 1, Factor),

    not_closed(F),
    %% Return a new nice head structure
    Head = #head{
      m  = M,
      next = Next,
      fptr = F,
      no_items = NoItems,
      n = N,
      type = Type,
      ets = Ftab,
      keypos = Kp},
    %% and a new nice Info structure
    Info = #info{
      ram_file = Ram,
      filename = Fname,
      name = Tab},
    {ok, Head, Info};

fopen_init_file(F, Tab, Fname, Type, Kp, Est, Ram, read) ->
    err(open_file, accces_mode).


%% Given a file  pointer, read and validate the head of the 
%% file, set opened field, return {ok, Head}

read_head(F, Fn, Access) ->
    case catch read_head_fields(F) of
	{ok, FH} ->
	    if
		FH#fileheader.cookie /= ?MAGIC ->
		    file:close(F),
		    {error, not_a_dets_file};
		FH#fileheader.version /= ?FILE_FORMAT_VERSION -> 
		    file:close(F),
		    case lists:member(FH#fileheader.version, 
				      ?CAN_BUMP_BY_REPAIR) of
			true ->
			    {error, version_bump};
			false ->
			    {error, bad_version}
		    end;
		FH#fileheader.trailer /= FH#fileheader.eof ->
		    file:close(F),
		    {error, not_closed};
		FH#fileheader.closed_properly /= 1  ->
		    file:close(F),
		    {error, not_closed};
		true ->
		    if
			Access == read_write ->
			    not_closed(F);
			true -> 
			    ignore
		    end,
		    H = #head{
		      m = FH#fileheader.m,
		      next = FH#fileheader.next,
		      fptr = F,
		      no_items= FH#fileheader.no_items,
		      n = FH#fileheader.n,
		      type = FH#fileheader.type,
		      keypos = FH#fileheader.keypos},
		    I = #info{filename = Fn, access = Access},
		    {ok, H, I}
	    end;
	Other ->
	    file:close(F),
	    Other
    end.

%% Read the fileheader
read_head_fields(Fd) ->
    case file:pread(Fd, 0, ?HEADSZ) of
	{ok, Bin} when size(Bin) == ?HEADSZ ->
	    [Freelist,
	     Cookie,
	     ClosedProperly,
	     Type2, 
	     Version,
	     M,
	     Next,
	     KeyPos,
	     NoItems, 
	     N] = bin2ints(Bin),
	    {ok, EOF} = file:position(Fd, eof),
	    case file:pread(Fd, EOF-4, 4) of
		{ok, BB} when size(BB) == 4 ->
		    {ok, #fileheader {freelist = Freelist,
				      cookie = Cookie,
				      closed_properly = ClosedProperly,
				      type = catch tt(Type2),
				      version = Version,
				      m = M,
				      next = Next,
				      keypos = KeyPos,
				      no_items = NoItems,
				      trailer = i32(binary_to_list(BB)),
				      eof = EOF,
				      n = N}};
		Other ->
		    Other
	    end;
	{ok, Bin} ->
	    {error, tooshort};
	Other ->
	    Other
    end.


tt(?SET) -> set;
tt(?BAG) -> bag;
tt(?DUPLICATE_BAG) -> duplicate_bag;
tt(set) -> ?SET;
tt(bag) -> ?BAG;
tt(duplicate_bag) -> ?DUPLICATE_BAG.


%% Given a filename, fsck it
fsck(Fname) ->
    case file:open(Fname, [binary, raw, read]) of
	{ok ,Fd} ->
	    case read_head_fields(Fd) of
		{ok, FH} ->
		    file:close(Fd),
		    Tab = make_ref(),
		    fsck(Tab, FH#fileheader.type, FH#fileheader.keypos,
			 Fname, 8);
		Other ->
		    file:close(Fd),
		    Other
	    end;
	Other ->
	    Other
    end.


fsck(Tab, Type, KeyPos, Fname, Bump) ->
    case catch fsck2(Tab, Type, KeyPos, Fname, Bump) of
	{'EXIT', Reason} -> err(fsck, Reason);
	Other -> Other
    end.

fsck2(Tab, Type, KeyPos, Fname, Bump) ->
    Tmp = Fname ++ ".TMP",
    file:delete(Tmp),
    case fopen(Tab, Tmp, Type,  KeyPos, false, default, false, read_write) of
	{error, Reason} -> 
	    {error, Reason};
	{ok, Head, I } ->  %% New empty file with wrong filename
	    {ok, Info} = file:file_info(Fname),
	    Fz = element(1, Info),
	    {ok, F} = file:open(Fname, [raw, binary, read]),
	    Cp = ?HEADSZ + ((?SEGSZ + ?SEGARRSZ) *  4 ), %% current pos
	    H2 = 
		case (Fz >= Cp) of
		    true ->
			do_fsck(Head, Tab, Cp, Fz, F, 0,Bump);
		    false ->
			%% Bad luck, the segment list was truncated /hakan
			Head
		end,
	    perform_sync(H2, I),
	    perform_close(H2, I),
	    file:close(F), %% the corrupted input file
	    ok = file:rename(Tmp, Fname)
    end.

%% Bump is 8 since all objects are allocated aligned to this
%% Bump is 1 if we use fsck to upgrade version of dets file
do_fsck(Head, Tab, Cp, Fz, F, I, Bump) ->
    case pread_12(F, Cp) of
	{Next, Sz, Magic} ->
	    case in_range(F, Cp, Fz, Sz, Magic) of
		{true, active} ->
		    {ok, Bin} = file:pread(F, Cp+12, Sz),
		    case catch erlang:old_binary_to_term(Bin) of
			{'EXIT', _} ->
			    do_fsck(Head, Tab , Cp + Bump, Fz, F, I+1,Bump);
			Term when Bump == 8 ->
			    ?TRACE("RECOVER ~p~n", [Term]),
			    H2 = finsert(Head, Term),
			    Cp2 = Cp + ?POW(sz2pos(Sz+12)),
			    do_fsck(H2, Tab, Cp2, Fz, F, I+1, Bump);
			Term when Bump == 1 ->
			    H2 = finsert(Head, Term),
			    Cp2 = Cp + Sz + 12,
			    do_fsck(H2, Tab, Cp2, Fz, F, I+1, Bump)
		    end;
		false ->
		    do_fsck(Head, Tab, Cp + Bump, Fz, F, I, Bump)
	    end;
	eof ->
	    Head
    end.

in_range(F, Cp, Fz, Sz, ?ACTIVE) when Cp + 12 + Sz  =< Fz ->
    {true, active};
in_range(F, Cp, Fz, Sz, Magic) -> 
    false.

not_closed(F) ->
    ok = file:pwrite(F, ?CLOSED_PROPERLY_POS, [0,0,0,0]).

fsync(H, I) ->
    case I#info.ram_file of
	true ->  %% dump contents to file
	    Fd = H#head.fptr,
	    {ok, Pos} = file:position(Fd, eof),
	    case file:pread(Fd, 0, Pos) of
		{ok, Bin} ->
		    case file:write_file(I#info.filename, Bin) of
			ok -> ok;
			Other -> err(sync, Other)
		    end;
		Other ->
		    err(sync, Other)
	    end;
	false ->
	    perform_sync(H, I)
    end.

perform_sync(H, I) when I#info.access == read_write ->
    F = H#head.fptr,
    ok = file:pwrite(F, ?D_POS, [?int32(H#head.m),
				 ?int32(H#head.next),
				 ?int32(H#head.keypos),
				 ?int32(H#head.no_items),
				 ?int32(H#head.n)]),
    file:sync(F);
perform_sync(H, I) ->
    ok.


fclose(H, Info) ->
    %% This first thing we do before closing is to
    %% merge the freelist

    perform_sync(H, Info),
    perform_close(H, Info).

perform_close(Head, Info) when Info#info.access == read_write ->
    F = Head#head.fptr,
    FL = Head#head.ets,
    combine(FL),

    %% we then proceed by writing the free list
    %% out to disc.

    L = whole_free_list(FL),
    B = term_to_binary(L),

    {ok,Pos} = file:position(F, eof),
    ok = file:pwrite(F, ?FREELIST_POS, ?int32(Pos)),
    ok = file:pwrite(F, Pos, [?ZERO, ?int32(size(B)), ?FREE_AS_LIST, 
			      B]), 
    ok = file:pwrite(F, ?CLOSED_PROPERLY_POS, [0,0,0,1]),
    {ok,Pos2} = file:position(F, eof),
    ok = file:pwrite(F, Pos2, i32(Pos2 + 4)),  %% sizeof file as trailer
    
    erlang:db_erase(FL),
    if
	Info#info.ram_file == false ->
	    file:close(F);
	Info#info.ram_file == true ->
	    %% Need to flush all data from the ram based dets
	    %% file out to the corresponding disc file
	    case ram_file:get_file_close(F) of
		{ok, Bin} ->
		    ok = file:write_file(Info#info.filename, Bin);
		Other ->
		    vformat("Can't close ramfile ~p~n",
			    [Other]),
		    Other
	    end
    end;
perform_close(_,_) ->
    ok.

exists(Fn) ->
    case file:open(Fn, [read, raw]) of
	{ok, F} ->
	    file:close(F), 
	    yes;
	_ ->
	    no
    end.

%% Depending on the value of Ret, this function can return either
%% objects or bindings.
%% Ret == (object || bindings)
fmatch_object(Head, Pat, Ret)  -> 
    Kp = Head#head.keypos,
    Key = if
	      Pat == '_' -> '_';
	      size(Pat) >= Kp  ->  element(Kp, Pat);
	      true -> '$end_of_table'  %% the most unlikeley key of'em all
	  end,
    case has_var(Key) of
	false ->
	    Objs = fread(Head, Key),
	    lists:zf(fun(O) ->  case do_match(O, Pat) of
				    false -> 
					false;
				    {true, Bs} when Ret == object ->
					{true, O};
				    {true, Bs} when Ret == bindings ->
					{true, fix_b(Bs)}
				end
		     end,  Objs);
	{true,_} -> %% Gotta scan the whole file
	    match_scan(Head, Pat, 0, Ret, [])
    end.

match_scan(_, _, ?SEGARRSZ, _, Ack) -> 
    Ack;
match_scan(Head, Pat, SegNo, Ret, Ack) ->
    Seg = pread_4(Head#head.fptr, ?HEADSZ + (4 * SegNo) ),
    if
	Seg == 0 ->
	    Ack;
	true ->
	    Ack2 = scan_seg(Head, Pat, SegNo, Seg, 0, Ret, Ack),
	    match_scan(Head, Pat, SegNo+1, Ret, Ack2)
    end.

scan_seg(Head, _,_, _, ?SEGSZ, _, Ack) -> Ack;
scan_seg(Head, Pat, SegNo, SegPos, SegSlot, Ret, Ack) ->
    %%    Slot = SegSlot + (SegNo * ?SEGSZ),
    Chain = pread_4(Head#head.fptr, SegPos + (4 * SegSlot) ),
    Ack2 = scan_chain(Head, Pat, Chain, Ret, Ack),
    scan_seg(Head, Pat, SegNo, SegPos, SegSlot+1, Ret, Ack2).

scan_chain(Head, Pat, 0, Ret, Ack) -> Ack;
scan_chain(Head, Pat, Pos, Ret, Ack) ->
    {ok, Next, Sz, Term} = prterm(Head#head.fptr, Pos),
    case do_match(Term, Pat) of
	{true , Bs} when Ret == bindings ->
	    scan_chain(Head, Pat, Next, Ret, [fix_b(Bs) | Ack]);
	{true , Bs} when Ret == object ->
	    scan_chain(Head, Pat, Next, Ret, [Term | Ack]);
	false ->
	    scan_chain(Head, Pat, Next, Ret, Ack)
    end.

fmatch_delete(Head, Pat)  ->
    Kp = Head#head.keypos,
    Key = if
	      Pat == '_' -> '_';
	      tuple(Pat), size(Pat) >= Kp -> element(Kp, Pat);
	      true -> '$end_of_table'
	  end,
    Dels = case has_var(Key) of
	       false ->
		   Slot = db_hash(Key, Head),
		   mdel_slot(Head, Pat, 0, Slot);
	       {true,_} ->
		   mdel_slots(Head, Pat, 0, 0)
	   end,
    X = Head#head.no_items - Dels,
    Head#head{no_items = X}.


mdel_slots(Head, Pat, Deletions, Slot) ->
    case mdel_slot(Head, Pat, 0, Slot) of
	'$end_of_table' ->  Deletions;
	D2 ->  mdel_slots(Head, Pat, Deletions + D2, Slot+1)
    end.

mdel_slot(Head, Pat, Dels, Slot) when Slot >= Head#head.next ->
    '$end_of_table';
mdel_slot(Head, Pat, Dels, Slot) ->
    {Pos, Chain} = chain(Head, Slot),
    mdel_scan(Head, Pat, Dels, Pos, Chain).

mdel_scan(Head, Pat, Dels, Prev, 0) -> 
    Dels;
mdel_scan(Head, Pat, Dels, Prev, Pos) -> 
    F = Head#head.fptr,
    {ok, Next, Sz, Term} = prterm(F, Pos),
    case do_match(Term, Pat) of
	false ->
	    mdel_scan(Head, Pat, Dels, Pos, Next);
	{true, _} ->
	    free(F, Head#head.ets, Pos, Sz+12),
	    ok = file:pwrite(F, Prev, ?int32(Next)),
	    mdel_scan(Head, Pat, Dels+1, Prev, Next)
    end.


fdelete(Head, Key) ->
    Slot = db_hash(Key, Head),
    Kp = Head#head.keypos,
    F = Head#head.fptr,
    {Pos, Chain} = chain(Head, Slot),
    case search_key(F, Pos, Chain, Key, Kp) of
	{no, _} ->
	    Head;
	{ok, Prev, Pos2, Next, Size, Term}  ->
	    Ets = Head#head.ets,
	    Items = loop_key_delete(Ets, F, Prev, Pos2, Next,Size, Key, 1, Kp),
	    X = Head#head.no_items - Items,
	    Head#head{no_items = X}
    end.

loop_key_delete(Ftab, F, Prev, Pos, Next, Size, Key, Deletions, Kp) ->
    free(F, Ftab, Pos, Size+12),
    ok = file:pwrite(F, Prev, ?int32(Next)),
    if
	Next == 0 ->
	    Deletions;
	true ->
	    case prterm(F, Next) of
		{ok, Next2, Size2, Term} when element(Kp, Term) == Key ->
		    loop_key_delete(Ftab, F, Prev, Next, Next2, Size2, Key, 
				    Deletions+1, Kp);
		_ ->
		    Deletions
	    end
    end.

fdelete_object(Head, Obj) when tuple(Obj), size(Obj) >= Head#head.keypos  ->
    Kp = Head#head.keypos,
    Key = element(Kp, Obj),
    Slot = db_hash(Key, Head),
    F = Head#head.fptr,
    {Pos, Chain} = chain(Head, Slot),
    case search_object(F, Pos, Chain, Key, Obj) of
	{no, _} ->
	    {Head, ok};
	{ok, Prev, Pos2, Next, Size} when Head#head.type /= duplicate_bag  ->
	    free(F, Head#head.ets, Pos2, Size+12),
	    ok = file:pwrite(F, Prev, ?int32(Next)),
	    X = Head#head.no_items - 1,
	    {Head#head{no_items = X}, ok};
	{ok, Prev, Pos2, Next, Size} ->
	    free(F, Head#head.ets, Pos2, Size+12),
	    ok = file:pwrite(F, Prev, ?int32(Next)),
	    X = Head#head.no_items - 1,
	    fdelete_object(Head#head{no_items = X}, Obj)
    end;

						%	    Ets = Head#head.ets,
						%	    Dels = loop_obj_delete(F, Ets, Prev, Pos, Next, Obj, Obj, Size, 1),
						%	    {Head#head{no_items = Head#head.no_items - Dels}, ok}

						%    end;
fdelete_object(Head, Obj) ->
    {Head, err(delete_object, notuple)}.

loop_obj_delete(F, Ets, Prev, Pos, Next, Obj, Obj, Size, Dels) ->
    free(F, Ets, Pos, Size+12),
    ok = file:pwrite(F, Prev, ?int32(Next)),
    if
	Next == 0 ->
	    Dels;
	true ->
	    {ok, Next2, Size2, Term2} = prterm(F, Next),
	    loop_obj_delete(F, Ets, Prev, Next, Next2, Obj, Term2, Size2, Dels+1)
    end;
loop_obj_delete(F, Ets, Prev, Pos, Next, Obj, Other, Size, Dels) when Next == 0 ->
    Dels;
loop_obj_delete(F, Ets, Prev, Pos, Next, Obj, Other, Size, Dels) ->
    {ok, Next2, Size2, Term2} = prterm(F, Next),
    loop_obj_delete(F, Ets, Pos, Next, Next2, Obj, Term2, Size2, Dels).


ftraverse(Head, Fun) ->
    N = Head#head.no_items,
    ftraverse(Head, Fun, 0, 0, N, []).
ftraverse(Head, Fun, Slot, Sofar, N, Ack)  when Sofar < N ->
    case fslot(Head, Slot) of
	'$end_of_table' -> 
	    [];
	[] ->  %% probably a very common case
	    ftraverse(Head, Fun, Slot+1, Sofar, N, Ack);
	Objs ->
	    case do_ftraverse(Fun, Objs, Ack) of
		{done, Result} ->
		    Result;
		{continue, Ack2} ->
		    Len = Sofar + length(Objs),
		    ftraverse(Head, Fun, Slot+1, Len, N, Ack2)
	    end
    end;
ftraverse(Head, Fun, Slot, Sofar, N, Ack) -> Ack.

do_ftraverse(Fun, [], Ack) ->
    {continue, Ack};
do_ftraverse(Fun, [O|Objs], Ack) ->
    case catch Fun(O) of
	continue  ->
	    do_ftraverse(Fun, Objs, Ack);
	{continue, Val} ->
	    do_ftraverse(Fun, Objs, [Val | Ack]);
	{done, Value} ->
	    {done, [Value|Ack]};
	Other ->
	    {done, err(traverse, Other)}
    end.

finfo(H, I) -> 
    [{type, H#head.type}, 
     {keypos, H#head.keypos}, 
     {size, H#head.no_items},
     {file_size, file_size(H#head.fptr)},
     {filename, I#info.filename}].

file_size(F) -> 
    {ok, Pos} = file:position(F, eof),
    Pos.

finfo(H, I, type) -> H#head.type;
finfo(H, I, keypos) -> H#head.keypos;
finfo(H, I, size) -> H#head.no_items;
finfo(H,I, file_size) -> file_size(H#head.fptr);
finfo(H, I, filename) -> I#info.filename;
finfo(H, I, memory) -> file_size(H#head.fptr);
finfo(H, I, pid) -> self();
finfo(_, _,_) -> err(info, badarg).

fslot(H, Slot) when Slot >= H#head.next ->
    '$end_of_table';
fslot(H, Slot) ->
    {Pos, Chain} = chain(H, Slot),
    collect_chain(H#head.fptr, Chain).

collect_chain(F, 0) -> [];
collect_chain(F, Pos) ->
    {ok, Next, Sz, Term} = prterm(F, Pos),
    [Term | collect_chain(F, Next)].


fread(Head, Key) ->
    Slot = db_hash(Key, Head),
    {Pos, Chain} = chain(Head, Slot),
    F = Head#head.fptr,
    Kp = Head#head.keypos,
    case search_key(F, Pos, Chain, Key, Kp) of
	{no, _} ->
	    [];
	{ok, Prev, Pos2, Next, Size, Term} when Head#head.type == set ->
	    [Term];
	{ok, Prev, Pos2, Next, Size, Term}  ->  %% bag or duplicate_bag
	    acc_fread(F, Pos2, Next, Key, [Term], Kp)
    end.

acc_fread(F, Prev, Pos, Key, Ack, Kp) ->
    case search_key(F, Prev, Pos, Key, Kp) of
	{ok, _, Pos2, Next2, _, Term2} ->
	    acc_fread(F, Pos2, Next2, Key, [Term2|Ack], Kp);
	_ ->
	    Ack
    end.

search_key(_,_,0,_,_) ->
    {no, 0};
search_key(F, Prev, Pos, Key, Kp) ->
    case prterm(F, Pos) of
	{ok, Next, Size, Term} when element(Kp, Term) == Key ->
	    {ok, Prev, Pos, Next, Size, Term};
	{ok, 0, Size, _} ->  %% Last obj in chain
	    {no, Pos};
	{ok, Next, _, _} ->
	    search_key(F, Pos, Next, Key, Kp);
	no ->
	    {no, Pos}
    end.

search_object(_,_,0,_,_) ->
    {no, 0};
search_object(F, Prev, Pos, Key, Term) ->
    case prterm(F, Pos) of
	{ok, Next, Size, Term} ->
	    {ok, Prev, Pos, Next, Size};
	{ok, 0, Size, Term2} ->  %% Last obj in chain
	    {no, Pos};
	{ok, Next, _, Term2}  ->
	    search_object(F, Pos, Next, Key, Term);
	_ ->
	    {no, Pos}
    end.

ffirst(H) ->
    ffirst(H, 0).
ffirst(H, Slot) ->
    case fslot(H, Slot) of
	'$end_of_table' -> '$end_of_table';
	[] -> ffirst(H, Slot+1);
	[X|_] -> element(H#head.keypos, X)
    end.

fnext(Head, Key) ->
    Slot = db_hash(Key, Head),
    fnext(Head, Key, Slot).
fnext(H, Key, Slot) ->
    case fslot(H, Slot) of
	'$end_of_table' -> '$end_of_table';
	L -> fnext_search(H, Key, Slot, L)
    end.
fnext_search(H, K, Slot, L) ->
    Kp = H#head.keypos,
    case beyond_key(K, Kp, L) of
	[] ->
	    fnext_slot(H, K, Slot+1);
	L2 -> element(H#head.keypos, hd(L2))
    end.

%% We gotta continue to search for the next key in the next slot
fnext_slot(H, K, Slot) ->
    case fslot(H, Slot) of
	'$end_of_table' -> '$end_of_table';
	[] -> fnext_slot(H, K, Slot+1);
	L -> element(H#head.keypos, hd(L))
    end.

beyond_key(K, Kp, []) -> [];
beyond_key(K, Kp, [H|T]) when element(Kp, H) /= K ->
    beyond_key(K, Kp, T);
beyond_key(K, Kp, [H|T]) when element(Kp, H) == K ->
    beyond_key2(K, Kp, T).

beyond_key2(K, Kp, []) -> [];
beyond_key2(K, Kp, [H|T]) when element(Kp, H) == K ->
    beyond_key2(K, Kp, T);
beyond_key2(K, Kp, L) ->
    L.

finsert(Head, Object) ->
    Kp = Head#head.keypos,
    Key = element(Kp, Object),
    Slot = db_hash(Key, Head),
    {Pos, Chain} = chain(Head, Slot),
    F = Head#head.fptr,
    Bin = term_to_binary(Object),
    Size = size(Bin),
    I = if 
	    Head#head.type == set ->
		case search_key(F, Pos, Chain, Key, Kp) of
		    {no, _} ->  %% insert new object at head of list
			DataPos = alloc(Head#head.ets, 12 + Size),
			ok = file:pwrite(F, DataPos, [?int32(Chain), 
						      ?int32(Size), 
						      ?ACTIVE_AS_LIST, Bin]),
			ok = file:pwrite(F, Pos, ?int32(DataPos)), 1;

		    {ok, Prev, Pos2, Next, Size2, Term} when Size > Size2    ->
			DataPos = alloc(Head#head.ets, 12 + Size),
			ok = file:pwrite(F, DataPos, [?int32(Next), 
						      ?int32(Size), 
						      ?ACTIVE_AS_LIST, Bin]),
			ok = file:pwrite(F, Prev, ?int32(DataPos)),
			free(F, Head#head.ets, Pos2, Size2+12), 
			0;
		    {ok, Prev, Pos2, Next, Size2, Term} ->
			ok = file:pwrite(F, Pos2+12, Bin), 
			0
		end;
	    Head#head.type == bag ->
		case search_object(F, Pos, Chain, Key, Object) of
		    {no, _} -> %% insert new object at head of list 
			DataPos = alloc(Head#head.ets, 12 + Size),
			ok = file:pwrite(F, DataPos, [?int32(Chain), 
						      ?int32(Size), 
						      ?ACTIVE_AS_LIST, Bin]),
			ok = file:pwrite(F, Pos, ?int32(DataPos)), 1;
		    _ -> %% Object already there 
			0
		end;
	    Head#head.type == duplicate_bag ->
		DataPos = alloc(Head#head.ets, 12 + Size),
		case search_key(F, Pos, Chain, Key, Kp) of
		    {no, _} ->  %% insert new object at head of list
			ok = file:pwrite(F, DataPos, [?int32(Chain), 
						      ?int32(Size), 
						      ?ACTIVE_AS_LIST, Bin]),
			ok = file:pwrite(F, Pos, ?int32(DataPos)), 1;
		    {ok, Prev, Pos2, Next, Size2, Term} -> %% link in object
			ok = file:pwrite(F, DataPos, [?int32(Pos2),
						      ?int32(Size),
						      ?ACTIVE_AS_LIST, Bin]),
			ok = file:pwrite(F, Prev, ?int32(DataPos)),
			1
		end

	end,
    H2 = Head#head{no_items = Head#head.no_items + I},
    if
	(H2#head.no_items > H2#head.next) ->
	    if (H2#head.fixed == false)->
		    grow(H2);
	       true ->
		    H2
	    end;
	true ->
	    H2
    end.




h(I) -> erlang:hash(I, ?BIG) - 1.  %% stupid BIF has 1 counts.

db_hash(Key, Head) ->
    H = h(Key),
    Hash = H rem Head#head.m,
    if
	Hash < Head#head.n ->
	    H rem (2 * Head#head.m);
	true ->
	    Hash
    end.


ensure_alloced(Head) ->
    Next = Head#head.next,
    if 
	(Next >= (?SEGSZ * ?SEGARRSZ)) -> %% can't grow no more
	    no;
	(Next rem ?SEGSZ) == 0 ->  %% alloc new segment
	    ?TRACE("Alloc new segment \n ", []),
	    Ftab = Head#head.ets,
	    combine(Ftab),
	    Nseg = Next div ?SEGSZ,
	    F = Head#head.fptr,
	    Segm = alloc(Ftab, 4 * ?SEGSZ),
	    {ok, _} = file:position(F, Segm),
	    zero(F, ?SEGSZ),
	    ok = file:pwrite(F,  ?HEADSZ + (4 * Nseg),  ?int32(Segm)),
	    Next + 1;
	true ->
	    Next + 1
    end.


grow(Head) ->
    F = Head#head.fptr,
    %% First ensure that space in the file is allocated
    case ensure_alloced(Head) of
	no -> %% no more growth .... fill buckets instead
	    Head;
	Next ->
	    N = Head#head.n,
	    {Pos, Chain} = chain(Head, N),
	    Kp = Head#head.keypos,
	    re_hash_chain(Head, Pos, Chain, Kp),
	    N2 = N + 1,
	    if
		N2 == Head#head.m ->
		    Head#head{n = 0, next = Next, m = 2 * Head#head.m};
		true ->
		    Head#head{next = Next, n = N2}
	    end
    end.

re_hash_chain(H2, Prev, 0,_) ->
    done;
re_hash_chain(H2, Prev, Chain, Kp) -> 
    F = H2#head.fptr,
    case prterm(F, Chain) of
	{ok, Next, Size, Term} ->
	    Key = element(Kp, Term),
	    New = h(Key) rem (2 * H2#head.m),
	    if
		New == (H2#head.n) ->
		    %% object remains in this chain
		    ?TRACE("Letting ~w remain in ~w~n", [Term, New]),
		    re_hash_chain(H2, Chain, Next, Kp);

		true -> %% need to relink this object
		    ?TRACE("Move ~w from ~w to ~w ~n", [Term,H2#head.n,
							New]),
		    ok = file:pwrite(F, Prev, ?int32(Next)),  %% unlinked
		    {Pos2, Ch2} = chain(H2, New),
		    Old = pread_4(F, Pos2),

		    %%set new chain to point to this obj
		    ok = file:pwrite(F, Pos2, ?int32(Chain)), 

		    %% now set this obj to point to what new chain pointed to
		    ok = file:pwrite(F, Chain, ?int32(Old)),

		    re_hash_chain(H2, Prev, Next, Kp)
	    end;
	no ->
	    done
    end.


zero(F, I) ->
    zero(F, I, 1).
zero(F, I, Times) ->
    L = list_to_binary(lists:duplicate(4 * I, 0)),
    do_zero(F, L, Times).

do_zero(F, L, 0) -> ok;
do_zero(F, L, Times) -> ok = file:write(F, L), do_zero(F, L, Times-1).

%% Read term from file at position Pos
prterm(F, Pos) ->
    case catch prterm2(F, Pos) of
	{'EXIT', Reason} -> %% truncated DAT file 
	    vformat("** dets: Corrupted or Truncated dets file ~p\n", [Reason]), 
	    {dets_error,Reason};
	Other -> 
	    Other
    end.

prterm2(F, Pos) ->
    {ok, B} = file:pread(F, Pos, 8),
    {B1, B2} = split_binary(B, 4),
    {Next, Sz} = {i32(B1), i32(B2)},
    %% skip over the status field
    {ok, Bin} = file:pread(F, Pos + 12, Sz),
    Term = erlang:old_binary_to_term(Bin),
    {ok, Next, Sz, Term}.



%% Can't be used at the bucket level!!!!
%% Only when we go down a chain
rterm(F) ->
    case catch rterm2(F) of
	{'EXIT', Reason} -> %% truncated DAT file 
	    vformat("** dets: Corrupted or Truncated dets file ~p\n", []), 
	    {dets_error,Reason};
	Other -> 
	    Other
    end.

rterm2(F) ->
    {ok, B} = file:read(F, 8),
    {B1, B2} = split_binary(B, 4),
    {Next, Sz} = {i32(B1), i32(B2)},
    file:position(F, {cur, 4}), %% skip over the status field
    {ok, Bin} = file:read(F, Sz),
    Term = erlang:old_binary_to_term(Bin),
    {ok, Next, Sz, Term}.

i32(Int) when binary(Int) ->
    i32(binary_to_list(Int));

i32(Int)  when integer(Int) -> [(Int bsr 24) band 255,
				(Int bsr 16) band 255,
				(Int bsr  8) band 255,
				Int band 255];
i32([X1,X2,X3,X4]) ->
    (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4.

i32(X1,X2,X3,X4) ->
    (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4.

bin2ints(B) when size(B) == 0 ->
    [];
bin2ints(B) ->
    {B1, B2} = split_binary(B, 4),
    [i32(B1) | bin2ints(B2)].

%% Implement the ets match algorithm in erlang itself
%% return false | {true, Bindings}
%% Max 10 variables :-(

do_match(Obj, Pat) ->
    case do_match(Obj, Pat, {no,no,no,no,no,no,no,no,no,no}) of
	false -> false;
	{bs, Bs} -> {true, Bs}
    end.

fix_b(Bs) ->
    fix_b(Bs, 1, 1 + size(Bs)).

fix_b(_, I, I) -> [];
fix_b(Bs, Pos, Last) ->
    case element(Pos, Bs) of
	no -> fix_b(Bs, Pos+1, Last);
	Val -> [Val | fix_b(Bs, Pos+1, Last)]
    end.


add_binding(Pos, Bs, Obj) ->
    case catch setelement(Pos, Bs, Obj) of
	{'EXIT', _} ->
	    Bs2 = grow_tuple(Bs, size(Bs)),
	    add_binding(Pos, Bs2, Obj);
	Other -> 
	    Other
    end.

grow_tuple(Tup, Sz) ->
    L = tuple_to_list(Tup),
    L2 = lists:duplicate(Sz + 10, no),
    list_to_tuple(L ++ L2).

binding(Pos, Tup) ->
    case catch element(Pos, Tup) of
	{'EXIT', _} ->
	    Bs2 = grow_tuple(Tup, size(Tup)),
	    {no, Bs2};
	Other -> Other
    end.

do_match(X, X, Bs) -> 
    {bs, Bs};
do_match([H1|T1], [H2|T2], Bs) -> 
    case do_match(H1, H2, Bs) of
	{bs, Bs2} -> do_match(T1, T2, Bs2);
	false -> false
    end;
do_match(Tup1, Tup2, Bs) when tuple(Tup1),tuple(Tup2), 
                              size(Tup1) == size(Tup2) ->
    e_match(Tup1, Tup2, size(Tup1), Bs);


do_match(Obj, '_', Bs) -> {bs, Bs};
do_match(Obj, Pat, Bs) -> 
    case is_var(Pat) of
	{true, Pos} when integer(Pos) ->
	    case binding(Pos + 1, Bs) of
		no ->
		    {bs, add_binding(Pos + 1, Bs, Obj)};
		{no, Bs2} ->
		    {bs, add_binding(Pos + 1, Bs2, Obj)};
		Obj ->
		    {bs, Bs};
		_ ->
		    false
	    end;
	{true, wild} ->
	    {bs, Bs};
	false ->
	    false
    end.

e_match(_, _, 0, Bs) -> {bs, Bs};
e_match(T1, T2, Pos, Bs) ->
    case do_match(element(Pos, T1), element(Pos, T2), Bs) of
	{bs, Bs2} -> e_match(T1, T2, Pos-1, Bs2);
	false -> false
    end.

is_var(X) when atom(X) ->
    case atom_to_list(X) of
	[$$, Dig] when $0 =< Dig, Dig =< $9 -> {true, Dig - $0};
	[$_] -> {true, wild};
	[$$ , Dig | Tail] -> accumulate_digs(lists:reverse([Dig |Tail]), 0,1);
	_ -> false
    end;
is_var(_) -> false.


has_var(X) when atom(X) -> 
    is_var(X);
has_var(X) when tuple(X) ->
    e_has_var(X, size(X));
has_var([H|T]) ->
    case has_var(H) of
	false -> has_var(T);
	Other -> Other
    end;
has_var(_) -> false.

e_has_var(X, 0) -> false;
e_has_var(X, Pos) ->
    case has_var(element(Pos, X))of
	false -> e_has_var(X, Pos-1);
	Other -> Other
    end.

accumulate_digs([], Ack, _) -> {true, Ack};
accumulate_digs([Dig|T], Ack, Pow) when $0 =< Dig, Dig =< $9 ->
    accumulate_digs(T, Ack + (Dig - $0) * Pow, Pow * 10);
accumulate_digs(_,_,_) -> false.


%%%%%%%%%%  server code %%%%%%%%%%%

start() ->
    case whereis(?MODULE) of
	undefined ->
	    register(?MODULE, spawn(?MODULE, loop0, []));
	Pid ->
	    Pid
    end,
    started.

start_link() ->
    case whereis(?MODULE) of
	undefined ->
	    register(?MODULE, spawn_link(?MODULE, loop0, []));
	Pid -> Pid
    end,
    started.

istart_link() ->  
    {ok, register(?MODULE, proc_lib:spawn_link(?MODULE, init, [self()]))}.

stop() ->
    case whereis(?MODULE) of
	undefined ->
	    stopped;
	Pid ->
	    req(?MODULE, stop)
    end.

-define(T, dets_registry).

verbose_flag() ->
    case init:get_argument(dets) of
	{ok, Args} ->
	    lists:member(["verbose"], Args);
	_ ->
	    false
    end.

init() ->
    set_verbose(verbose_flag()),
    process_flag(trap_exit, true),
    ets:new(?T, [set, named_table]),
    ets:new(?MODULE, [duplicate_bag]).

init(Parent) ->
    Store = init(),
    server_loop(#state{store=Store, parent=Parent}).

loop0() ->
    Store = init(),
    server_loop(#state{store=Store}).


server_loop(S) ->
    Store = S#state.store,
    receive
	{From, {open, Tab, Fname, Type, Keypos, Rep, Est, RamBool, Acc}} ->
	    case ets:lookup(?T, Tab) of
		[] -> 
		    Pid = spawn(?MODULE, do_open_file, 
				[Tab, Fname, Type, 
				 Keypos, Rep, get(verbose),
				 Est, RamBool, Acc]),
		    receive
			{Pid, {ok, Result}} ->
			    do_link(Store, From),
			    ets:insert(Store, {From, Tab}),
			    ets:insert(?T, {Tab, Pid, 1}),
			    From ! {?MODULE, {ok, Result}};
			{Pid, {error, Reason}} ->
			    From ! {?MODULE, {error, Reason}}
		    end;
		[{Tab, Pid, Counter}] ->
		    Pid ! {self(), {add_user, Tab, Fname, Type, Keypos, Rep, RamBool, Acc}},
		    receive
			{Pid, {ok, Result}} ->
			    do_link(Store, From),
			    ets:insert(Store, {From, Tab}),
			    ets:insert(?T, {Tab, Pid, Counter+1}),
			    From ! {?MODULE, {ok, Result}};
			{Pid, {error, Reason}} ->
			    From ! {?MODULE, {error, Reason}}
		    end

	    end;
	{From, {open, File}} ->
	    Pid = spawn(?MODULE, do_open_file, [File, get(verbose)]),
	    receive
		{Pid, {ok, Tab}} ->
		    do_link(Store, From),
		    ets:insert(Store, {From, Tab}),
		    ets:insert(?T, {Tab, Pid, 1}),
		    From ! {?MODULE, {ok, Tab}};
		{Pid, {error, Reason}} ->
		    From ! {?MODULE, {error, Reason}}
	    end;
	{From, {close, Tab}} ->
	    Res = handle_close(S, From, Tab),
	    From ! {?MODULE, Res};

	{'EXIT', From, _} ->
	    %% First we need to figure out which tables that
	    %% From are using
	    All = ets:lookup(Store, From),
	    handle_all(S, All);

	{From, stop} ->
	    All = ets:tab2list(Store),
	    lists:foreach(fun({{links, _}, _}) -> 
				  ignore;
			     ({Pid, Tab}) -> 
				  handle_close(S, Pid, Tab)
			  end, All),
	    From ! {?MODULE, stopped},
	    [] = ets:tab2list(Store),  %% assertion
	    exit(normal);
	{From, {set_verbose , What}} ->
	    set_verbose(true);
	{system, From, Req} ->
	    sys:handle_system_msg(Req, From, S#state.parent, ?MODULE, [], S);
	Other ->
	    ok % maybe we ought to log this, which is not expected to occur
    end,
    server_loop(S).


%handle_close(S, From, Tab) ->
%    Store = S#state.store,
%    do_unlink(Store, From),
%    ets:delete(Store, {From, Tab}),
%    case ets:lookup(?T, Tab) of
%	[] -> 
%	    {error, not_open};
%	[{Tab, Pid, 1}] ->
%	    ets:delete(?T, Tab),
%	    ets:match_delete(Store, {From, Tab}),
%	    Pid ! {self(), close},
%	    receive {Pid, {closed, Res}} -> Res end;
%	[{Tab, Pid, Counter}] ->
%	    ets:delete(?T, Tab),
%	    ets:match_delete(Store, {From, Tab}),
%	    ets:insert(?T, {Tab, Pid, Counter-1}),
%	    ok
%    end.



handle_close(S, From, Tab) ->
    Store = S#state.store,
    case ets:match(Store,{From,Tab}) of
	[] -> 
	    %%io:format("DETS: Table ~w close attempt by non-owner~w~n",
	    %%      [Tab, From]),
	    {error, not_owner};
	_ ->
	    case ets:lookup(?T, Tab) of
		[] -> 
		    {error, not_open};
		[{Tab, Pid, 1}] ->
		    do_unlink(Store, From),
		    ets:delete(?T, Tab),
		    ets:match_delete(Store, {From, Tab}),
		    Pid ! {self(), close},
		    receive {Pid, {closed, Res}} -> Res end;
		[{Tab, Pid, Counter}] ->
		    do_unlink(Store, From),
		    ets:delete(?T, Tab),
		    ets:match_delete(Store, {From, Tab}),
		    ets:insert(?T, {Tab, Pid, Counter-1}),
		    ok
	    end
    end.

handle_all(S, []) ->
    done;
handle_all(S, [{From, Tab} | Tail]) ->
    handle_close(S, From, Tab),
    handle_all(S, Tail).


%% Links with counters
do_link(Store, Pid) ->
    Key = {links, Pid},
    case ets:lookup(Store, Key) of
	[] ->
	    ets:insert(Store, {Key, 1}),
	    link(Pid);
	[{_, C}] ->
	    ets:delete(Store, Key),
	    ets:insert(Store, {Key, C+1})
    end.

do_unlink(Store, Pid) ->
    Key = {links, Pid},
    case ets:lookup(Store, Key) of
	[{_, C}] when C > 1 ->
	    ets:delete(Store, Key),
	    ets:insert(Store, {Key, C-1}),
	    true;
	_ ->
	    ets:delete(Store, Key),
	    unlink(Pid)

    end.

do_open_file(Fname, Verbose) ->
    process_flag(trap_exit, true),
    case fopen(Fname) of
	{error, tooshort} ->
	    file:delete(Fname),
	    do_open_file(Fname, Verbose);
	{error, Reason} ->
	    ?MODULE ! {self(), err(open_file, Reason)},
	    exit(normal);
	{ok, Head, I} ->
	    ?MODULE ! {self(), {ok, I#info.name}},
	    maybe_put(verbose, Verbose),
	    open_file_loop(Head, I, I#info.access)
    end.


do_open_file(Tab, Fname, Type, Kp, Rep, Verbose, Est, Ram, Acc)  ->
    process_flag(trap_exit, true),
    case fopen(Tab, Fname, Type, Kp, Rep, Est, Ram, Acc) of
	{error, tooshort} ->
	    file:delete(Fname),
	    do_open_file(Tab, Fname, Type, Kp, Rep, Verbose, Est, Ram, Acc);
	{error, Reason} ->
	    ?MODULE ! {self(), err(open_file, Reason)},
	    exit(normal);
	{ok, Head, I} ->
	    ?MODULE ! {self(), {ok, Tab}},
	    maybe_put(verbose, Verbose),
	    open_file_loop(Head, I, I#info.access)
    end.

error_action(_, _, _, _, normal) ->  %% on close
    exit(normal);
error_action(H, I, From, Op, Reason)  ->
    vformat("dets (info=~p) file loop  "
	    "failed to perform ~p~n"
	    "Reason was: ~p~n",
	    [I, Op, Reason]),
    Operation =
	case Op of
	    {X, Y} -> X;
	    _ -> Op
	end,
    catch From ! {self(), err(Operation, Reason)},
    open_file_loop(H, I, I#info.access).  %% tail recursice call to continue anyway


maybe_put(_, undefined) ->
    ignore;
maybe_put(K, V) ->
    put(K, V).

%% This loop never dies due to crashes and such,
%% If for example a writeop fails, the call will
%% return error and the dets loop continue to operate

open_file_loop(Head, I, Acc) ->
    receive
	{From, Op} ->
	    case catch apply_op(Op, From, Head, I, Acc) of
		ok -> 
		    open_file_loop(Head, I, Acc);
		{'EXIT', Reason} ->
		    error_action(Head, I, From, Op, Reason);
		H2 ->
		    open_file_loop(H2, I, Acc)
	    end
    end.

apply_op(Op, From, Head, I, Acc) ->
    case Op of
	{lookup, Key} ->
	    Res = fread(Head, Key),
	    From ! {self(), Res},
	    ok;
	{insert, Obj} when tuple(Obj), Acc == read_write ->
	    H2 = finsert(Head, Obj),
	    From ! {self(), ok},
	    H2;
	{add_user, Tab, Fname, Type, Keypos, _, Ram, Access} ->
	    Res = if
		      Tab == I#info.name,
		      Head#head.keypos == Keypos,
		      Head#head.type == Type,
		      I#info.ram_file == Ram,
		      Acc == Access,
		      Fname == I#info.filename ->
			  {ok, Tab};
		      true ->
			  err(open_file, incompatible)
		  end,
	    From ! {self(), Res},
	    ok;
	{match_object, Pat} ->
	    From ! {self(), fmatch_object(Head, Pat, object)},
	    ok;
	{delete, Key} when Acc == read_write ->
	    H2 = fdelete(Head, Key),
	    From ! {self(), ok},
	    H2;
	{delete_object, Key} when Acc == read_write ->
	    {H2, Res} = fdelete_object(Head, Key),
	    From ! {self(), Res},
	    H2;
	close  ->
	    Res = (catch fclose(Head, I)),
	    From ! {self(), {closed, Res}},
	    exit(normal);
	first ->
	    From ! {self(), ffirst(Head)},
	    ok;
	{next, Key} ->
	    From ! {self(), fnext(Head, Key)},
	    ok;
	{match, Pat} ->
	    From ! {self(), fmatch_object(Head, Pat, bindings)},
	    ok;
	{match_delete, Pat} when Acc == read_write ->
	    H2 = fmatch_delete(Head, Pat),
	    From ! {self(), ok},
	    H2;
	{slot, Slot} ->
	    From ! {self(), fslot(Head, Slot)},
	    ok;
	{traverse, F} ->
	    From ! {self(), ftraverse(Head, F)},
	    ok;
	{update_counter, Key, C} when Head#head.type == set, Acc == read_write ->
	    {R,H2} = case fread(Head, Key) of
			 [O] ->
			     Kp = Head#head.keypos,
			     case catch try_update_tuple(O, Kp, C) of
				 {'EXIT', _} ->
				     {err(update_counter, badarg), Head};
				 {New, Term2} ->
				     {New, finsert(Head,  Term2)}
			     end;
			 _ ->
			     {err(update_counter, badarg), Head}
		     end,
	    From ! {self(), R},
	    H2;
	info ->
	    From ! {self(), finfo(Head, I)},
	    ok;
	{info, Tag} ->
	    From ! {self(), finfo(Head, I, Tag)},
	    ok;
	sync ->
	    From ! {self(), fsync(Head, I)},
	    ok;
	{set_verbose, What} ->
	    set_verbose(What), ok;
	{fixtable, true} ->
	    From ! {self(), ok},
	    Head#head{fixed = true};
	{fixtable, false} ->
	    From ! {self(), ok},
	    Head#head{fixed = false};
	{Operation, Arg} ->  %% catch all access errors
	    catch From ! {self(), err(Operation, badarg)},
	    ok;
	Other ->
	    catch From ! {self(), err(unknown, Other)},
	    ok
    end.

set_verbose(true) ->
    put(verbose, yes);
set_verbose(_) ->
    erase(verbose).

try_update_tuple(O, Kp, C) ->
    New = element(Kp+1, O) + C,
    {New, setelement(Kp+1, O, New)}.

%%-----------------------------------------------------------------
%% Callback functions for system messages handling.
%%-----------------------------------------------------------------
system_continue(Parent, _, State) ->
    server_loop(State).

system_terminate(Reason, Parent, _, State) ->
    stop(),
    exit(Reason).

%%-----------------------------------------------------------------
%% Temporay code for upgrade.
%%-----------------------------------------------------------------
system_code_change(State, _Module, OldVsn, Extra) ->
    {ok, State}.



%%%%%  client functions %%%%

%% Assuming that a file allready exists, open it with the
%% parameters as already specified in the file itself.
%% Return a ref leading to the file.
open_file(File) ->
    ensure_started(),
    req(?MODULE, {open, File}).

open_file(Tab, Args) ->     
    ensure_started(),
    case catch defaults(Tab, Args) of
	[{file, File}, 
	 {type, Type}, 
	 {keypos, KeyPos}, 
	 {repair, Rep}, 
	 {estimated_no_objects, Est}, 
	 {ram_file, RamBool},
	 {access, Acc}] ->
	    req(?MODULE, {open, Tab, File, Type, KeyPos, Rep, Est, RamBool, Acc});
	_ ->
	    err(open_file, badarg)
    end.

close(Tab) ->  
    req(?MODULE, {close, Tab}).

-define(proc(X), erlang:db_get_element(?T, X, 2)).

lookup(Tab, Key) ->        req(?proc(Tab), {lookup, Key}).
insert(Tab, Obj) ->        req(?proc(Tab), {insert, Obj}).
sync(Tab) ->               req(?proc(Tab), sync).
match_object(Tab, Pat) ->  req(?proc(Tab), {match_object, Pat}).
match(Tab, Pat)       ->   req(?proc(Tab), {match, Pat}).
match_delete(Tab, Pat)  -> req(?proc(Tab), {match_delete, Pat}).
delete(Tab, Key) ->        req(?proc(Tab), {delete, Key}).
traverse(Tab, F) ->        req(?proc(Tab), {traverse, F}).
delete_object(Tab, O) ->   req(?proc(Tab), {delete_object, O}).
first(Tab) ->              req(?proc(Tab), first).
next(Tab, Key) ->          req(?proc(Tab), {next, Key}).
update_counter(Tab,Key,C)->req(?proc(Tab), {update_counter, Key, C}).
slot(Tab, Slot) ->         req(?proc(Tab), {slot, Slot}).
info(Tab) ->               req(?proc(Tab), info).
info(Tab, Tag) ->          req(?proc(Tab), {info, Tag}).
fixtable(Tab, Bool) ->     req(?proc(Tab), {fixtable, Bool}).
all() ->                   ensure_started(), 
			   lists:map(fun(X) -> element(1, X) end, 
				     ets:tab2list(?T)).


verbose() ->           
    verbose(true).
verbose(What) ->
    ensure_started(), 
    ?MODULE ! {self(), {set_verbose, What}},
    lists:map(fun(X) -> 
		      Pid = element(2, X),
		      Pid ! {self(), {set_verbose, What}}
	      end,
	      ets:tab2list(?T)).

req(Proc, R) -> 
    Proc ! {self(), R},
    receive 
	{Proc, Reply} -> 
	    Reply;
	{'EXIT', Proc, Reason} ->
	    exit(Reason)
    end.

ensure_started() ->
    case whereis(?MODULE) of
	undefined -> 
	    DetsServer = {dets, {dets, istart_link, []},
			  permanent, 2000, worker, [dets]},
	    supervisor:start_child(kernel_safe_sup,DetsServer);
	_ -> ok
    end.

%% Process the args list as provided to open_file/2
defaults(Tab, Args) ->
    Defaults = [{file, to_list(Tab)},
		{type, set},
		{keypos, 1},
		{repair, true}, 
		{estimated_no_objects, default},
		{ram_file, false},
		{access, read_write}],
    Fun = fun repl/2,
    lists:foldl(Fun, Defaults, Args).

to_list(T) when atom(T) -> atom_to_list(T);
to_list(T) -> T.

positive_int_or_default(default) -> default;
positive_int_or_default(I) when I > 1 -> I.

repl({file, File}, Defs) ->
    lists:keyreplace(file, 1, Defs, {file, to_list(File)});
repl({type, T}, Defs) ->
    mem(T, [set, bag, duplicate_bag]),
    lists:keyreplace(type, 1, Defs, {type, T});
repl({keypos, P}, Defs) when integer(P) , P > 0 ->
    lists:keyreplace(keypos, 1, Defs, {keypos, P});
repl({repair, T}, Defs) ->
    mem(T, [true, false]),
    lists:keyreplace(repair, 1, Defs, {repair, T});
repl({ram_file, Bool}, Defs) ->
    mem(Bool, [true, false]),
    lists:keyreplace(ram_file, 1, Defs, {ram_file, Bool});
repl({estimated_no_objects, I}, Defs)  ->
    positive_int_or_default(I),
    lists:keyreplace(estimated_no_objects, 1, Defs,{estimated_no_objects,I});
repl({access, A}, Defs) ->
    mem(A, [read, read_write]),
    lists:keyreplace(access, 1, Defs, {access, A});
repl({_, _}, _) ->
    exit(badarg).

mem(X, L) ->
    case lists:member(X, L) of
	true -> true;
	false -> exit(badarg)
    end.

file_info(F) ->
    case file:rawopen(F, {binary, read}) of
	{ok, Fd} ->
	    case read_head_fields(Fd) of
		{ok, FH} ->
		    if
			FH#fileheader.closed_properly /= 1 ->
			    file:close(Fd),
			    {error, not_closed};
			FH#fileheader.cookie /= ?MAGIC ->
			    file:close(Fd),
			    {error, not_a_dets_file};
			FH#fileheader.version /= ?FILE_FORMAT_VERSION ->
			    file:close(Fd),
			    {error, bad_version};
			true ->
			    file:close(Fd),
			    ok
		    end;
		Other ->
		    file:close(Fd),
		    Other
	    end;
	Other ->
	    Other
    end.


%%%%%%%%%%%%%%%%%  DEBUG functions %%%%%%%%%%%%%%%%

%% debug fun to inspect position Pos in an open file
inspect_chain(H, Pos) ->
    F = H#head.fptr,
    file:position(F, Pos),
    case read_4(F) of
	0 -> 
	    0;
	I ->
	    case read_8(F) of
		{Sz, ?FREE} -> 
		    {ok, Bin} = file:read(F, Sz),
		    {free, {next, I}, {obj, catch term_to_binary(Bin)}};
		{Sz, ?ACTIVE} ->
		    {ok, Bin} = file:read(F, Sz),
		    {active, {next, I}, {obj, catch term_to_binary(Bin)}};
		_ ->
		    not_an_object
	    end
    end.

%% Dump the contents of a DAT file to the tty
%% internal debug function which ignores the closed properly thingie
%% and just tries anyway

view(Fn) ->
    case file:open(Fn, [raw, binary, read]) of
	{ok, F} ->
	    {ok, H0, I} = read_head(F, Fn, read),
	    Ftab = init_freelist(H0#head.fptr, notrunc),
	    H = H0#head{ets=Ftab},
	    v_free_list(H, F),
	    v_segments(H, 0),
	    ets:delete(Ftab),
	    file:close(F);
	X -> 
	    X
    end.

v_free_list(H, F) ->
    io:format("FREE LIST ...... \n",[]),
    fl_dump(H#head.ets),
    io:format("END OF FREE LIST \n",[]).

v_segments(H, ?SEGARRSZ) ->
    done;
v_segments(H, SegNo) ->
    io:format("SEGMENT ~w ", [SegNo]),
    file:position(H#head.fptr, ?HEADSZ + (4 * SegNo)),
    Seg = read_4(H#head.fptr),
    io:format("At position ~w~n", [Seg]),
    if
	Seg == 0 ->
	    done;
	true ->
	    v_segment(H, SegNo, Seg, 0),
	    v_segments(H, SegNo+1)
    end.

v_segment(H, _, SegPos, ?SEGSZ) ->
    done;
v_segment(H, SegNo, SegPos, SegSlot) ->
    Slot = SegSlot + (SegNo * ?SEGSZ),
    file:position(H#head.fptr, SegPos + (4 * SegSlot)),
    Chain = read_4(H#head.fptr),
    if 
	Chain == 0 ->  %% don't print empty chains
	    true;
	true ->
	    io:format("   <~p>~p: [",[SegPos + (4 * SegSlot), Slot]),
	    print_chain(H, Chain)
    end,
    v_segment(H, SegNo, SegPos, SegSlot+1).

print_chain(H, 0) ->
    io:format("] \n", []);
print_chain(H, Pos) ->
    file:position(H#head.fptr, Pos),
    case catch rterm(H#head.fptr) of
	{ok, 0, Sz, Term} ->
	    io:format("<~p>~p] \n",[Pos, Term]);
	{ok, Next, Sz, Term} ->
	    io:format("<~p>~p, ", [Pos, Term]),
	    print_chain(H, Next);
	Other ->
	    io:format("ERROR ~p~n", [Other])
    end.

err(Op, {error, Reason}) -> 
    err(Op, Reason);
err(open_file, tooshort) ->  %% Bizzare special case
    {error, tooshort};
err(Op, Reason) ->
    case get(verbose) of
	yes -> 
	    error_logger:format("dets: ~w failed with ~w~n", [Op, Reason]),
	    {error, {Op, Reason}};
	undefined  ->
	    {error, {Op, Reason}}
    end.

vformat(F, As) ->
    case get(verbose) of
	yes -> error_logger:format(F, As);
	_ -> ok
    end.

delete_all(H, [H|T]) -> delete_all(H, T);
delete_all(H, [H1|T]) -> [H1|delete_all(H,T)];
delete_all(H, []) -> [].


%%%%%%%%%%%%%%% allocation routines %%%%%%%%%%%%%%
%%% Algorithm : We use a buddy system on each file. This is nicely described
%%%             In i.e. the last chapter of the first-grade text book 
%%%             Data structures and algorithms by Aho, Hopcroft and
%%%             Ullman. I think buddy systems were invented by Knuth, a long
%%%             time ago.

init_freelist(F, Truncate) ->
    Ftab = erlang:db_create(dets_freelist,[set]),

    Pos = pread_4(F, ?FREELIST_POS),
    {0, Size, Status} = pread_12(F, Pos),
    {ok,  B} = file:pread(F, Pos+12, Size),

    FreeList = erlang:old_binary_to_term(B),
    lists:foreach(fun(Item) -> 
			  ets:insert(Ftab,Item) 
		  end, FreeList),
    if
	Truncate == trunc ->
	    {ok, _} = file:position(F, Pos),
	    file:truncate(F);
	true ->
	    ok
    end,
    Ftab.

init_alloc() ->
    Ftab = erlang:db_create(dets_freelist, [set]),
    init_fl(Ftab, 0),
    Ftab.

init_fl(Ftab, ?MAXBUD) -> 
    erlang:db_put(Ftab, {?MAXBUD, ?BASE}),
    erlang:db_put(Ftab, {?BASE, 0});
init_fl(Ftab, Slot) -> 
    erlang:db_put(Ftab, {Slot, 0}),
    init_fl(Ftab, Slot+1).


r(Ftab, Addr) -> erlang:db_get_element(Ftab, Addr, 2).
w(Ftab, Addr, V) -> erlang:db_put(Ftab, {Addr, V}).
e(Ftab, Addr) -> erlang:db_erase(Ftab, Addr).

alloc(Ftab, Sz) ->
    Pos = sz2pos(Sz),
    case r(Ftab, Pos) of
	0 -> %% Hard case gotta search upward
	    X = find_next_free(Ftab, Pos+1),
	    move_down(Pos, X, Ftab),
	    alloc(Ftab, Sz);
	Bm ->  %% At position Bm in the file, we have a block
	    w(Ftab, Pos, r(Ftab, Bm)),
	    e(Ftab, Bm),
	    Bm
    end.

find_next_free(Ftab, Pos) ->
    case r(Ftab, Pos) of  %% read free list
	0 -> find_next_free(Ftab, Pos+1);
	I -> Pos
    end.

move_down(X, X, Ftab) ->
    ok;
move_down(Opos, SplitSlot, Ftab) ->
    Size = ?POW(SplitSlot),
    Bm = r(Ftab, SplitSlot),  %% got head
    Chain = r(Ftab, Bm),
    w(Ftab, SplitSlot, Chain),
    w(Ftab, SplitSlot-1, Bm),      %% move down
    Half = (Bm + (Size bsr 1)),
    w(Ftab, Bm, Half),
    w(Ftab, Half, 0),
    move_down(Opos, SplitSlot-1, Ftab).

sz2pos(Sz0) ->
    sz2pos(Sz0, 0).
sz2pos(Li, Pos) when Li > 0 ->
    sz2pos(Li bsr 1, Pos+1);
sz2pos(Li, Pos) ->
    Pos.

free(F, Ftab, Addr, Sz) ->
    ok = file:pwrite(F, Addr+8, ?FREE_AS_LIST),  %% set status field
    Slot = sz2pos(Sz),
    Fl = r(Ftab, Slot),
    w(Ftab, Slot, Addr),
    w(Ftab, Addr, Fl).

combine(Ftab) ->
    combine(Ftab, 1).

%% Foreach chunk that hangs on Slot, try to combine it
%% with all other elems On Slot and insert it in Slot+1
combine(_, Slot) when Slot > ?MAXBUD ->
    ok;
combine(Ftab, Slot) ->
    Sz = ?POW(Slot),
    L = free_list(Ftab, Slot),
    combine(Ftab, Slot, Sz, tl(lists:sort(L))).

combine(Ftab, Slot, Sz, [{C1, X} , {C2, Y}|T]) ->
    case buddies(C1, C2, Sz) of
	yes ->
	    {Prev1, Prev2} = search_chain(Ftab, Slot, C1, C2),
	    %% C1 and C2 are buddies and
	    %% Prev1 and Prev2 are the 2 previous pointers respectively
	    Xr = r(Ftab, C1),
	    Yr = r(Ftab, C2),
	    if
		C1 == Yr ->  %% C2 points at C1
		    w(Ftab, Prev2, Xr);
		C2 == Xr ->  %% C1 points at C2
		    w(Ftab, Prev1, Yr);
		true ->     %% They are not linked together
		    w(Ftab, Prev1, Xr),
		    w(Ftab, Prev2, Yr)   %% unlink them both
	    end,

	    Fl = r(Ftab, Slot+1),
	    w(Ftab, Slot+1, C1),    %% join
	    w(Ftab, C1, Fl),
	    e(Ftab, C2),
	    combine(Ftab, Slot, Sz, T);
	no ->
	    combine(Ftab, Slot, Sz, [{C2, Y}|T])
    end;
combine(Ftab, Slot, Sz, _) ->
    combine(Ftab, Slot + 1).

search_chain(Ftab, Slot, C1, C2) ->
    search_chain(Ftab, Slot, r(Ftab, Slot), C1, C2, no, no).
search_chain(_, Prev, _, _, _, R1, R2) when R1 /= no, R2 /= no ->
    {R1, R2};
search_chain(Ftab, Prev, Pos, C1, C2 , R1, R2) when Pos == C1 ->
    search_chain(Ftab, C1, r(Ftab, Pos), C1, C2, Prev, R2);
search_chain(Ftab, Prev, Pos, C1, C2 , R1, R2) when Pos == C2 ->
    search_chain(Ftab, C2, r(Ftab, Pos), C1, C2, R1, Prev);
search_chain(Ftab, Prev, Pos, C1, C2, R1, R2) ->
    search_chain(Ftab, Pos, r(Ftab, Pos), C1, C2, R1, R2).

whole_free_list(Ftab) ->
    whole_free_list(Ftab, 1).
whole_free_list(Ftab, Slot) when Slot > ?MAXBUD ->
    [];
whole_free_list(Ftab, Slot) ->
    free_list(Ftab, Slot) ++ whole_free_list(Ftab, Slot+1).

free_list(Ftab, Addr) ->
    free_list(Ftab, Addr, []).
free_list(Ftab, Addr, Ack) ->
    case r(Ftab, Addr) of
	0 -> [{Addr, 0} | Ack];
	Ptr -> free_list(Ftab, Ptr, [{Addr, Ptr} | Ack])
    end.

%% Are chunks at addresses X and Y buddies ??
%% They're both of size Sz0.
buddies(X, Y, Sz0) ->
    Sz = Sz0 bsl 1,
    if
	((X - ?BASE) div Sz) == ((Y - ?BASE) div Sz) ->
	    yes;
	true ->
	    no
    end.

fl_dump(Ftab) ->
    fl_dump(Ftab, 1).
fl_dump(Ftab, Slot) when Slot > ?MAXBUD ->
    done;
fl_dump(Ftab, Slot) ->
    Fl = r(Ftab, Slot),
    io:format("SLOT ~p: ~p, ",[Slot, Fl]),
    follow_chain(Ftab, Fl),
    io:nl(),
    fl_dump(Ftab, Slot+1).

follow_chain(Ftab, 0) -> ok;
follow_chain(Ftab, Bm) -> io:format(" ~p,", [C = r(Ftab, Bm)]),
			  follow_chain(Ftab, C).



