%%
%% Copyright (c) 2004 Iwata <iwata@quasiquote.org>
%%
%% Permission to use, copy, modify, and distribute this software for any
%% purpose with or without fee is hereby granted, provided that the above
%% copyright notice and this permission notice appear in all copies.
%%
%% THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
%% WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
%% MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
%% ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
%% WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
%% ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
%% OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
%%

-module(um).
-author('iwata@quasiquote.org').

-export([load_test/0]).

-define(UINT32_MAX, 4294967296).
-define(UM_PAGE_SIZE, 4096).

-record(um, {
	  regs = [],
	  platter = [],
	  platter_offset,
	  ef = 0,              %% execution finger
	  textsize = 0,
	  bt = [],             %% backtrace
	  bt_depth = 10,
	  exec = [fun eval/1]  %% default behavior
	 }).

put_char(C) ->
    if
	(32 =< C) and (C =< 126)->
	    io:format("'~c',  ", [C]);
	true ->
	    io:format("0x~2.16.0B, ", [C])
    end.

get_reg(Reg, Um) ->
    [{_, R}] = ets:lookup(Um#um.regs, Reg),
    s_to_us(R).

set_reg(Reg, N, Um) ->
    ets:insert(Um#um.regs, {Reg, s_to_us(N)}).

get_platter(Offset, Um) ->
    case ets:lookup(Um#um.platter, Offset) of
	[{_, Platter}] ->
	    Platter;
	_ ->
	    {error, bounce_error}
    end.
get_platter(Um) ->
    get_platter(Um#um.platter_offset + Um#um.ef, Um).

set_platter(Offset, Platter, Um) ->
    ets:insert(Um#um.platter, {Offset, Platter}).

erase_platter(Offset, Um) ->
    ets:delete(Um#um.platter, Offset).

get_ef(Um) ->
    Um#um.ef.

set_ef(Offset, Um) ->
    Um#um{ ef = Offset }.
next_ef(Um) ->
    set_ef(Um#um.ef + 1, Um).

set_addr(POff, Offset, Um) ->
    Um#um{ platter_offset = POff, ef = Offset }.

set_backtrace(Op, Um) ->
    %% simple queue
    Len = length(Um#um.bt),
    if
	Len < Um#um.bt_depth ->
	    Um#um{ bt = [{Um#um.platter_offset, Um#um.ef, Op} | Um#um.bt] };
	true ->
	    T = lists:sublist(Um#um.bt, Len - 1),
	    Um#um{ bt = [{Um#um.platter_offset, Um#um.ef, Op} | T] }
    end.

backtrace(Um) ->
    io:format("backtrace:~n"),
    lists:foreach(fun (Bt) ->
			  case Bt of
			      {POff, Ef, Op} ->
				  disasm(Op, POff, Ef);
			      _ ->
				  true
			  end
		  end,
		  Um#um.bt).

%%
%% heap operation
%%

pages(Size) ->
    trunc((Size + 1) / ?UM_PAGE_SIZE) + 1.

page_top(Offset, Size) ->
    Offset + ?UM_PAGE_SIZE * pages(Size).

is_free_page(Offset, Um) ->
    case ets:lookup(Um#um.platter, Offset) of
	[{_, _}] ->
	    false;
	[] ->
	    true
    end.

find_free_pages(Offset, Size, Um) ->
    Top = page_top(Offset, Size),
    if
	?UINT32_MAX < Um#um.textsize ->
	    {error, "No room"};
	true ->
	    %% io:format("alloc [~8.16.0B-~8.16.0B], size ~p bytes~n", [Top, Offset, Size]),
	    %% io:format("new heap [ "),
	    %% [io:format("~8.16.0B ", [X]) || X <- lists:seq(Top, Offset, ?UM_PAGE_SIZE)],
	    %% io:format("]~n"),
	    case lists:dropwhile(fun (Page) ->
					 %% io:format("check ~8.16.0B is ~p~n", [Page, is_free_page(Page, Um)]),
					 is_free_page(Page, Um)
				 end,
				 lists:seq(Offset, Top, ?UM_PAGE_SIZE)) of
		[] ->
		    {ok, Offset};
		[Last | _] ->
		    %% io:format("retrying at ~8.16.0B ...~n", [Last - ?UM_PAGE_SIZE]),
		    find_free_pages(Last + 1, Size, Um)  % retry
	    end
    end.
find_free_pages(Size, Um) ->
    find_free_pages(0, Size, Um).

alloc(Size, Um) ->
    case find_free_pages(Size, Um) of
	{ok, Offset} ->
	    io:format("alloc [~8.16.0B-~8.16.0B]~n", [Offset + 1, Offset + ?UM_PAGE_SIZE * pages(Size)]),
	    %% io:format("write head ~8.16.0B <= ~p~n", [Offset, pages(Size)]),
	    [set_platter(X, <<0:32>>, Um) || X <- lists:seq(Offset + 1, Offset + ?UM_PAGE_SIZE * pages(Size))],
	    set_platter(Offset, <<(pages(Size)):32>>, Um),
	    {ok, Offset + 1};
	Error ->
	    Error
    end.

free(Offset, Um) ->
    <<Pages:32>> = get_platter(Offset - 1, Um),
    io:format("free [~8.16.0B-~8.16.0B]~n", [Offset, Offset + ?UM_PAGE_SIZE * Pages - 1]),
    [erase_platter(X, Um) || X <- lists:seq(Offset - 1, Offset + ?UM_PAGE_SIZE * Pages - 1)].

dup(Offset, Um)->
    <<Pages:32>> = get_platter(Offset - 1, Um),
    Size = Pages * ?UM_PAGE_SIZE,
    %% io:format("dup ~8.16.0B(~p bytes) to ", [Offset, Size]),
    case alloc(Size, Um) of
	{ok, Ptr} ->
	    %% io:format("~8.16.0B", [Ptr]),
	    [set_platter(Ptr + X, get_platter(Offset + X, Um), Um) || X <- lists:seq(0, Size - 1)],
	    {ok, Ptr};
	Error ->
	    Error
    end.

%%
%% utility functions
%%
dump(Um) ->
    lists:foreach(fun (Reg) ->
			  io:format("[reg_~p:~8.16.0B] ", [Reg, s_to_us(get_reg(Reg, Um))]),
			  if
			      ((Reg rem 4) == 3) ->
				  io:format("~n");
			      true ->
				  true
			  end
		  end,
		  lists:seq(0, 7)).

warn(Warn, Um) ->
    io:format("<<< UM WARN: ~s >>>~n", [Warn]),
    dump(Um),
    backtrace(Um).
    
fatal(Error, Um) ->
    io:format("<<< UM ERROR: ~s >>>~n", [Error]),
    dump(Um),
    backtrace(Um),
    halt.

s_to_us(I) when I < 0 ->
    ?UINT32_MAX + I;
s_to_us(I) ->
    I.

%%
%%                          A     C
%%                          |     |
%%                          vvv   vvv                    
%%  .--------------------------------.
%%  |VUTSRQPONMLKJIHGFEDCBA9876543210|
%%  `--------------------------------'
%%   ^^^^                      ^^^
%%   |                         |
%%   operator number           B
%%

%
% Operator #0. Conditional Move.
%
%  The register A receives the value in register B,
%  unless the register C contains 0.
%
op(<<0:4, _:19, _A:3, _B:3, _C:3>>, disasm) ->
    io:format("cmov\treg_~p, reg_~p (reg_~p != 0)", [_B, _A, _C]);

op(<<0:4, _:19, _A:3, _B:3, _C:3>>, Um) ->
    case get_reg(_C, Um) of
	0 ->
	    {ok, next_ef(Um)};
	_ ->
	    set_reg(_A, get_reg(_B, Um), Um),
	    {ok, next_ef(Um)}
    end;

%
% Operator #1. Array Index.
%
%  The register A receives the value stored at offset
%  in register C in the array identified by B.
%
op(<<1:4, _:19, _A:3, _B:3, _C:3>>, disasm) ->
    io:format("idx\treg_~p[reg_~p] -> reg_~p\t", [_B, _C, _A]);

op(<<1:4, _:19, _A:3, _B:3, _C:3>>, Um) ->
    Ident = get_reg(_B, Um),
    Offset = if
		 Ident == 0 ->
		     Um#um.platter_offset;
		 true ->
		     Ident
	     end,
    case get_platter(Offset + get_reg(_C, Um), Um) of
	<<Val:32>> ->
	    set_reg(_A, Val, Um),
	    {ok, next_ef(Um)};
	_ ->
	    fatal("Segmentation Fault", Um)
    end;

%
% Operator #2. Array Amendment.
%
%  The array identified by A is amended at the offset
%  in register B to store the value in register C.
%
op(<<2:4, _:19, _A:3, _B:3, _C:3>>, disasm) ->
    io:format("amd\treg_~p[reg_~p] <- reg_~p\t", [_A, _B, _C]);

op(<<2:4, _:19, _A:3, _B:3, _C:3>>, Um) ->
    Ident = get_reg(_A, Um),
    Reg = get_reg(_C, Um),
    Offset = if
		 Ident == 0 ->
		     Um#um.platter_offset;
		 true ->
		     Ident
	  end,
    set_platter(Offset + get_reg(_B, Um), <<Reg:32>>, Um),
    {ok, next_ef(Um)};

%
% Operator #3. Addition.
%
%  The register A receives the value in register B plus 
%  the value in register C, modulo 2^32.
%
op(<<3:4, _:19, _A:3, _B:3, _C:3>>, disasm) ->
    io:format("add\treg_~p, reg_~p -> reg_~p\t", [_B, _C, _A]);

op(<<3:4, _:19, _A:3, _B:3, _C:3>>, Um) ->
    set_reg(_A, (get_reg(_B, Um) + get_reg(_C, Um)) rem ?UINT32_MAX, Um),
    {ok, next_ef(Um)};

%
% Operator #4. Multeflication.
%
%  The register A receives the value in register B times
%  the value in register C, modulo 2^32.
%
op(<<4:4, _:19, _A:3, _B:3, _C:3>>, disasm) ->
    io:format("mul\treg_~p, reg_~p -> reg_~p\t", [_B, _C, _A]);

op(<<4:4, _:19, _A:3, _B:3, _C:3>>, Um) ->
    set_reg(_A, (get_reg(_B, Um) * get_reg(_C, Um)) rem ?UINT32_MAX, Um),
    {ok, next_ef(Um)};

%
% Operator #5. Division.
%
%  The register A receives the value in register B
%  divided by the value in register C, if any, where
%  each quantity is treated treated as an unsigned 32
%  bit number.
%
op(<<5:4, _:19, _A:3, _B:3, _C:3>>, disasm) ->
    io:format("div\treg_~p, reg_~p -> reg_~p\t", [_B, _C, _A]);

op(<<5:4, _:19, _A:3, _B:3, _C:3>>, Um) ->
    case get_reg(_C, Um) of
	0 ->
	    fatal("Divide by 0", Um);
	C ->
	    set_reg(_A, trunc(get_reg(_B, Um) / C), Um),
	    {ok, next_ef(Um)}
    end;

%
% Operator #6. Not-And.
%
%  Each bit in the register A receives the 1 bit if
%  either register B or register C has a 0 bit in that
%  position.  Otherwise the bit in register A receives
%  the 0 bit.
%
op(<<6:4, _:19, _A:3, _B:3, _C:3>>, disasm) ->
    io:format("nand\treg_~p, reg_~p -> reg_~p\t", [_B, _C, _A]);

op(<<6:4, _:19, _A:3, _B:3, _C:3>>, Um) ->
    set_reg(_A, bnot(get_reg(_B, Um) band get_reg(_C, Um)), Um),
    {ok, next_ef(Um)};

%
% Operator #7. Halt.
%
% The universal machine stops computation.
%
op(<<7:4, _:28>>, disasm) ->
    io:format("halt\t\t\t\t");

op(<<7:4, _:28>>, _Um) ->
    halt;

%
% Operator #8. Allocation.
%
%  A new array is created with a capacity of platters
%  commensurate to the value in the register C. This
%  new array is initialized entirely with platters
%  holding the value 0. A bit pattern not consisting of
%  exclusively the 0 bit, and that identifies no other
%  active allocated array, is placed in the B register.
%
op(<<8:4, _:19, _A:3, _B:3, _C:3>>, disasm) ->
    io:format("alloc\treg_~p -> reg_~p\t\t", [_C, _B]);

op(<<8:4, _:19, _A:3, _B:3, _C:3>>, Um) ->
    Size = get_reg(_C, Um),
    case alloc(Size, Um) of
	{ok, Ptr} ->
	    set_reg(_B, Ptr, Um),
	    {ok, next_ef(Um)};
	{error, Error} ->
	    fatal(Error, Um)
    end;

%
% Operator #9. Abandonment.
%
%  The array identified by the register C is abandoned.
%  Future allocations may then reuse that identifier.
%
op(<<9:4, _:19, _A:3, _B:3, _C:3>>, disasm) ->
    io:format("abnd\treg_~p\t\t\t", [_C]);

op(<<9:4, _:19, _A:3, _B:3, _C:3>>, Um) ->
    free(get_reg(_C, Um), Um),
    {ok, next_ef(Um)};

%
% Operator #10. Output.
%
%  The value in the register C is displayed on the console
%  immediately. Only values between and including 0 and 255
%  are allowed.
%
op(<<10:4, _:19, _A:3, _B:3, _C:3>>, disasm) ->
    io:format("output\treg_~p\t\t\t", [_C]);

op(<<10:4, _:19, _A:3, _B:3, _C:3>>, Um) ->
    Ch = get_reg(_C, Um),
    if
	(0 =< Ch) and (Ch =< 255) ->
	    io:format("~c", [Ch]),
	    {ok, next_ef(Um)};
	true ->
	    fatal("Unknown Charactor", Um)
    end;

%
% Operator #11. Input.
%
%  The universal machine waits for input on the console.
%  When input arrives, the register C is loaded with the
%  input, which must be between and including 0 and 255.
%  If the end of input has been signaled, then the 
%  register C is endowed with a uniform value pattern
%  where every place is pregnant with the 1 bit.
%
op(<<11:4, _:19, _A:3, _B:3, _C:3>>, disasm) ->
    io:format("input\treg_~p\t\t\t", [_C]);

op(<<11:4, _:19, _A:3, _B:3, _C:3>>, Um) ->
    case io:get_chars('um>', 1) of
	eof ->
	    halt;
	Ch ->
	    if
		(0 =< Ch) and (Ch =< 255) ->
		    set_reg(_C, Ch, Um),
		    {ok, next_ef(Um)};
		true ->
		    fatal("Unknown Charactor", Um)
	    end
    end;

%
%  Operator #12. Load Program.
%
%  The array identified by the B register is duplicated
%  and the duplicate shall replace the '0' array,
%  regardless of size. The execution finger is placed
%  to indicate the platter of this array that is
%  described by the offset given in C, where the value
%  0 denotes the first platter, 1 the second, et
%  cetera.
%
op(<<12:4, _:19, _A:3, _B:3, _C:3>>, disasm) ->
    io:format("load\treg_~p[reg_~p]\t\t", [_B, _C]);

op(<<12:4, _:19, _A:3, _B:3, _C:3>>, Um) ->
    Off = get_reg(_C, Um),
    POff = case get_reg(_B, Um) of
	       0 ->
		   Um#um.platter_offset;
	       Ident ->
		   case dup(Ident, Um) of
		       {ok, Ptr} ->
			   free(Um#um.platter_offset, Um),
			   io:format("load: dup ~8.16.0B to ~8.16.0B~n", [Ident, Ptr]),
			   Ptr;
		       {error, Error} ->
			   fatal(Error, Um)
		   end
	   end,
    {ok, set_addr(POff, Off, Um)};

%       A  
%       |  
%       vvv
%  .--------------------------------.
%  |VUTSRQPONMLKJIHGFEDCBA9876543210|
%  `--------------------------------'
%   ^^^^   ^^^^^^^^^^^^^^^^^^^^^^^^^
%   |      |
%   |      value
%   |
%   operator number

%
% Operator #13. Orthography.
%
%  The value indicated is loaded into the register A
%  forthwith.
%
op(<<13:4, _A:3, V1:1, V2:8, V3:8, V4:8>>, disasm) ->
    io:format("orh\t"),
    lists:foreach(fun(C) -> put_char(C) end,
		  [V1, V2, V3, V4]),
    io:format("reg_~p", [_A]);

op(<<13:4, _A:3, V:25>>, Um) ->
    set_reg(_A, V, Um),
    {ok, next_ef(Um)};

%%
op(<<V1:8, V2:8, V3:8, V4:8>>, disasm) ->
    io:format("data\t"),
    lists:foreach(fun(C) -> put_char(C) end,
		  [V1, V2, V3, V4]);

op(<<_:32>>, Um) ->
    fatal("Unknown Instruction", Um).

init() ->
    Regs    = ets:new(regs, [set, private]),
    Platter = ets:new(platter, [set, private]),
    [ets:insert(Regs, {X, 0}) || X <- lists:seq(0, 7)],
    #um{ regs = Regs, platter = Platter}.

finish(Um) ->
    ets:delete(Um#um.regs),
    ets:delete(Um#um.platter).

disasm(Op) ->
    op(Op, disasm).

disasm(Op, Platter_Offset, Offset) ->
    io:format("~8.16.0B:~8.16.0B\t", [Platter_Offset, Offset]),
    op(Op, disasm),
    <<A, B, C, D>> = Op,
    io:format("\t\t[~2.16.0B~2.16.0B~2.16.0B~2.16.0B]~n", [A, B, C, D]).
disasm(Op, Offset) ->
    io:format("~8.16.0B\t", [Offset]),
    op(Op, disasm),
    <<A, B, C, D>> = Op,
    io:format("\t\t[~2.16.0B~2.16.0B~2.16.0B~2.16.0B]~n", [A, B, C, D]).

load_dev(Dev, Platter, Offset, Um) ->
    case Platter of
        eof ->
            file:close(Dev),
	    true;
        {ok, Op} ->
	    set_platter(Offset, Op, Um),
	    load_dev(Dev, file:read(Dev, 4), Offset + 1, Um);
        Error ->
            Error
    end.

eval(Um) ->
    Op = get_platter(Um),
%%    BtUm = set_backtrace(Op, Um),
%%    op(Op, BtUm).
    op(Op, Um).


load_file(Fn, Um) ->
    case file:open(Fn, [read, binary]) of
	{ok, Dev} ->
	    case filelib:file_size(Fn) of
		0 ->
		    {error, empty_platter};
		Len ->
		    case alloc(Len, Um) of
			{ok, Ptr} ->
			    load_dev(Dev, file:read(Dev, 4), Ptr, Um),
			    Um#um{ platter_offset = Ptr };
			{error, Error} ->
			    {error, Error}
		    end
	    end;
	Error ->
	    Error
    end.


run(Um) ->
    case eval(Um) of
	halt ->
	    true;
	{ok, NextUm} ->
	    run(NextUm);
	Error ->
	    Error
    end.


load_test() ->
    Um = init(),
    LUm = load_file("sandmark.umz", Um),
    run(LUm),
    %%io:format("dump~n"),
    %%[disasm(get_platter(X, Um), X) || X <- lists:seq(16#FFFFC800, 16#FFFFF7FF)],
    finish(LUm),
    init:stop().