% prolog facts/rules to emulate fetch/decode/execute in marie
%    currently only supports input, output, halt, add, clear
%       and only positive integers

% run(M,R)
% --------
% run a Marie program where M is a list representing the
%        contents of memory at the start of the program,
%     and R is a list representing some of the register contents
%        in order [ ACC, PC, IR ]
%
% the contents of each register and each memory cell is
%     represented using a string of 4 hex digits
%        e.g. for the program below M would be
%            [ "5000", "2005", "3005", "6000", "7000", "0003" ]
%
%             input
%             store   X
%             add     X
%             output
%             halt
%        X,   hex     3
%
run(M,R) :-
        fetch(M,R,R1),       % R1 contains the register values after the fetch/decode
        execute(M,R1,R2,M2), % R2 and M2 are the register/memory contents after execution
        !, (testforhalt(R2)  % quit if the instruction was halt,
        ; run(M2,R2)).       %    otherwise continue execution with new M and R


% fetch(M,R,Rnew)
% ---------------
% fetch the next instruction from memory,
%    using the PC (second element of R) to identify the correct element of M
% the contents of Rnew should be the same as R except as follows:
%    the IR element should contain the newly fetched instruction
%    the PC element should be greater by 1
fetch(M,[Acc, PC, _] , [Acc, NewPC, NewIR] ) :-
   int2hexstr(Addr, PC),
   nth0(Addr, M, NewIR),     % look up the instruction
   NewAddr is Addr + 1,     % calculate the next instruction address
   int2hexstr(NewAddr, NewPC).


% execute(M,R,Rnew,Mnew)
% ----------------------
% given M,R represent the current memory and register lists,
%    identify the instruction (the IR element of R), then
%    compute/set the updated register and memory lists

% execute the halt instruction: nothing changes, just succeed
execute(_, [_, _, "7000"], _, _).

% execute the output instruction: no content changes,
%    but the contents of Acc are displayed
execute(M, [Acc, PC, "6000"] , [Acc, PC, "6000"], M) :-
   format("~w~n", [Acc]).

% execute the input instruction: the contents of Acc are updated by a read
execute(M, [_, PC, "5000"] , [NewAcc, PC, "5000"], M) :-
   format("Enter a value followed by a period, e.g. 32.~n"),
   read(NewAcc).

% execute the clear instruction: the contents of Acc are changed to 0
execute(M, [_, PC, "A000"] , ["0000", PC, "A000"], M).

% execute the add instruction: the contents of the Acc are updated\
execute(M, [Acc, PC, IR], [NewAcc, PC, IR], M) :-
   instrMatch("2000", IR),           % make sure the first char of instruction is "2"
   extractArg(IR, "2000", MemAddr),  % get the memory address from the instruction
   lookupMemVal(MemAddr, M, MemVal), % get the int val from memory address
   int2hexstr(AccVal, Acc),          % get the value from Acc as an integer
   NewAccVal is AccVal + MemVal,     % compute int value for new Acc
   int2hexstr(NewAccVal, NewAcc).    % convert to string for register


% testforhalt(R)
% --------------
% succeeds iff the IR element of R is the halt instruction
testforhalt( [_, "7000" | _] ).


% lookupMemVal(Addr, Mem, Val)
% ----------------------------
% given an address in memory, lookup the value stored there as an integer
lookupMemVal(Addr, Mem, Val) :-
   nth0(Addr, Mem, MemStr),     % look up string in memory location
   int2hexstr(Val, MemStr).     % convert to integer


% extractArg(InstrStr, BaseStr, IntArg)
% -------------------------------------
% given a hex string, InstrStr, representing an instruction, (e.g. "2005")
%    and a base string, BaseStr, representing the instruction type (e.g. "2000")
%    extract the argument portion as an integer (e.g. 5)
extractArg(InstrStr, BaseStr, IntArg) :-
   int2hexstr(MCode, InstrStr),   % get the machine code instruction as an integer
   int2hexstr(OpCode, BaseStr),   % get the opcode value
   IntArg is MCode - OpCode.      % get the memory address as an integer


% int2hexstr(I,HS)
% ----------------
% converts between an integer value I and a hex string HS
int2hexstr(I,HS) :- integer(I), format(atom(HS), "~16r", [I]).
int2hexstr(I,HS) :- atom_concat('0x', HS, HexStr),
     atom_codes(HexStr, Codes), number_codes(I, Codes).


% instrMatch(Base,HS)
% -------------------
% succeeds if first char of Base matches first char of string HS
instrMatch(Base, HS) :-
       atom_chars(HS, L), nth0(0, L, C),
       atom_chars(Base, LB), nth0(0, LB, CB), C == CB.


% testCase(N)
% -----------
% run the simulator on a numbered test case

% test case 0: just halt
testCase(0) :- M = [ "7000" ],
               R = [ "0000", "0000", "0000" ],
               run(M,R).

% test case 1: read a number, write it, then halt
testCase(1) :- M = [ "5000", "6000", "7000" ],
               R = [ "0000", "0000", "0000" ],
               run(M,R).

% test case 2: read a number, write it, clear, output, then halt
testCase(2) :- M = [ "5000", "6000", "A000", "6000", "7000" ],
               R = [ "0000", "0000", "0000" ],
               run(M,R).

% test case 3: read a number, output, add 3 from end of prog, output, then halt
testCase(3) :- M = [ "5000", "6000", "2005", "6000", "7000", "0003" ],
               R = [ "0000", "0000", "0000" ],
               run(M,R).