aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions
RosettaCodeData/Task/Compiler-virtual-machine-interpreter/Phix/compiler-virtual-machine-interpreter-2.phix
Ingy döt Net f23f22d71c Initial data commit
2023-07-01 13:44:08 -04:00

367 lines
10 KiB
Text
Raw Permalink Blame History

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%
%%% The Rosetta Code Virtual Machine, for GNU Prolog.
%%%
%%% The following code uses GNU Prolog's extensions for global
%%% variables.
%%%
%%% Usage: vm [INPUTFILE [OUTPUTFILE]]
%%% The notation "-" means to use standard input or standard output.
%%% Leaving out an argument is equivalent to specifying "-".
%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
make_and_run_machine(Input, Output) :-
make_machine(Input),
run_machine(Output).
run_machine(Output) :-
repeat,
next_instruction(Opcode, Arg),
(Opcode == ('halt')
-> true
; (run_instruction(Output, Opcode, Arg),
fail % Backtracks to the 'repeat'.
)).
run_instruction(Output, Opcode, Arg) :-
(
(Opcode == ('add'),
pop_value(Y),
pop_value(X),
is(Z, X + Y),
push_value(Z))
; (Opcode == ('sub'),
pop_value(Y),
pop_value(X),
is(Z, X - Y),
push_value(Z))
; (Opcode == ('mul'),
pop_value(Y),
pop_value(X),
is(Z, X * Y),
push_value(Z))
; (Opcode == ('div'),
pop_value(Y),
pop_value(X),
is(Z, X // Y),
push_value(Z))
; (Opcode == ('mod'),
pop_value(Y),
pop_value(X),
is(Z, X rem Y),
push_value(Z))
; (Opcode == ('lt'),
pop_value(Y),
pop_value(X),
(X < Y -> Z = 1; Z = 0),
push_value(Z))
; (Opcode == ('le'),
pop_value(Y),
pop_value(X),
(X =< Y -> Z = 1; Z = 0),
push_value(Z))
; (Opcode == ('gt'),
pop_value(Y),
pop_value(X),
(X > Y -> Z = 1; Z = 0),
push_value(Z))
; (Opcode == ('ge'),
pop_value(Y),
pop_value(X),
(X >= Y -> Z = 1; Z = 0),
push_value(Z))
; (Opcode == ('eq'),
pop_value(Y),
pop_value(X),
(X =:= Y -> Z = 1; Z = 0),
push_value(Z))
; (Opcode == ('ne'),
pop_value(Y),
pop_value(X),
(X =\= Y -> Z = 1; Z = 0),
push_value(Z))
; (Opcode == ('and'),
pop_value(Y),
pop_value(X),
((X =\= 0, Y =\= 0) -> Z = 1; Z = 0),
push_value(Z))
; (Opcode == ('or'),
pop_value(Y),
pop_value(X),
((X =\= 0; Y =\= 0) -> Z = 1; Z = 0),
push_value(Z))
; (Opcode == ('neg'),
pop_value(X),
is(Z, -X),
push_value(Z))
; (Opcode == ('not'),
pop_value(X),
(X =:= 0 -> Z = 1; Z = 0),
push_value(Z))
; (Opcode == ('prtc'),
pop_value(X),
char_code(C, X),
write(Output, C))
; (Opcode == ('prti'),
pop_value(X),
write(Output, X))
; (Opcode == ('prts'),
pop_value(K),
g_read(the_strings(K), S),
write(Output, S))
; (Opcode == ('fetch'),
g_read(the_data(Arg), X),
push_value(X),
skip_argument)
; (Opcode == ('store'),
pop_value(X),
g_assign(the_data(Arg), X),
skip_argument)
; (Opcode == ('push'),
push_value(Arg),
skip_argument)
; (Opcode == ('jmp'),
relative_jump(Arg))
; (Opcode == ('jz'),
pop_value(X),
(X =:= 0
-> relative_jump(Arg)
; skip_argument))
).
relative_jump(Offset) :-
g_read(the_program_counter, PC),
is(PC1, PC + Offset),
g_assign(the_program_counter, PC1).
skip_argument :-
g_read(the_program_counter, PC),
is(PC1, PC + 4),
g_assign(the_program_counter, PC1).
next_instruction(Opcode, Arg) :-
g_read(the_program_counter, PC),
is(PC1, PC + 1),
g_assign(the_program_counter, PC1),
g_read(the_code(PC), {Opcode, Arg}).
push_value(X) :-
g_read(the_stack_pointer, SP),
is(SP1, SP + 1),
g_assign(the_stack_pointer, SP1),
g_assign(the_stack(SP), X).
pop_value(X) :-
g_read(the_stack_pointer, SP),
is(SP1, SP - 1),
g_assign(the_stack_pointer, SP1),
g_read(the_stack(SP1), X).
make_machine(Input) :-
get_and_parse_the_header(Input, Datasize, Strings_Count),
(Strings_Count =:= 0
-> true
; get_and_parse_the_strings(Input, Strings_Count)),
get_and_parse_the_instructions(Input),
(Datasize =:= 0
-> true
; g_assign(the_data, g_array(Datasize))),
g_assign(the_stack, g_array(2048)),
g_assign(the_stack_pointer, 0),
g_assign(the_program_counter, 0).
get_and_parse_the_header(Stream, Datasize, Strings_Count) :-
get_line(Stream, Line, ('\n')),
parse_header(Line, Datasize, Strings_Count).
get_and_parse_the_strings(Stream, Strings_Count) :-
% Make 'the_strings' an array of the string literals.
get_and_parse_the_strings(Stream, Strings_Count, Lst),
g_assign(the_strings, g_array(Lst)).
get_and_parse_the_strings(Stream, I, Lst) :-
% Note: this implementation is non-tail recursive.
(I == 0
-> Lst = []
; (get_line(Stream, Line, ('\n')),
parse_string_literal(Line, S),
is(I1, I - 1),
get_and_parse_the_strings(Stream, I1, Lst1),
Lst = [S | Lst1])).
get_and_parse_the_instructions(Stream) :-
get_and_parse_the_instructions(Stream, Lst),
keysort(Lst, Lst1),
last(Lst1, Addr_Max-_),
is(Code_Size, Addr_Max + 5),
g_assign(the_code, g_array(Code_Size, {('halt'), 0})),
maplist(fill_instruction, Lst1).
get_and_parse_the_instructions(Stream, Lst) :-
get_and_parse_the_instructions(Stream, [], Lst).
get_and_parse_the_instructions(Stream, Lst0, Lst) :-
% This implementation is tail recursive. We consider the order of
% the resulting list to be arbitrary.
(get_line(Stream, Line, Terminal),
drop_spaces(Line, S),
(S = []
-> (Terminal = end_of_file
-> Lst = Lst0
; get_and_parse_the_instructions(Stream, Lst0, Lst))
; (parse_instruction(S, Address, Opcode, Arg),
Instr = Address-{Opcode, Arg},
(Terminal = end_of_file
-> reverse([Instr | Lst0], Lst)
; get_and_parse_the_instructions(Stream, [Instr | Lst0],
Lst))))).
fill_instruction(Addr-Instr) :-
g_assign(the_code(Addr), Instr).
parse_header(Line, Datasize, Strings_Count) :-
drop_nondigits(Line, Lst1),
split_digits(Lst1, Datasize_Digits, Rest1),
drop_nondigits(Rest1, Lst2),
split_digits(Lst2, Strings_Digits, _Rest2),
number_chars(Datasize, Datasize_Digits),
number_chars(Strings_Count, Strings_Digits).
parse_string_literal(Line, S) :-
drop_spaces(Line, Lst1),
Lst1 = ['"' | Lst2],
rework_escape_sequences(Lst2, Lst3),
atom_chars(S, Lst3).
rework_escape_sequences(Lst0, Lst) :-
(Lst0 = [('"') | _]
-> Lst = []
; (Lst0 = [('\\'), ('n') | Tail1]
-> (rework_escape_sequences(Tail1, Lst1),
Lst = [('\n') | Lst1])
; (Lst0 = [('\\'), ('\\') | Tail1]
-> (rework_escape_sequences(Tail1, Lst1),
Lst = [('\\') | Lst1])
; (Lst0 = [C | Tail1],
rework_escape_sequences(Tail1, Lst1),
Lst = [C | Lst1])))).
parse_instruction(Line, Address, Opcode, Arg) :-
drop_spaces(Line, Lst1),
split_digits(Lst1, Address_Digits, Rest1),
number_chars(Address, Address_Digits),
drop_spaces(Rest1, Lst2),
split_nonspaces(Lst2, Opcode_Chars, Rest2),
atom_chars(Opcode, Opcode_Chars),
drop_spaces(Rest2, Lst3),
(Lst3 = []
-> Arg = 0
; (Lst3 = [C | Rest3],
(is_digit(C)
-> (split_digits(Lst3, Arg_Chars, _),
number_chars(Arg, Arg_Chars))
; (C = ('(')
-> (split_before_char((')'), Rest3, Arg_Chars, _),
number_chars(Arg, Arg_Chars))
; (C = ('['),
split_before_char((']'), Rest3, Arg_Chars, _),
number_chars(Arg, Arg_Chars)))))).
is_space(C) :-
(C = (' '); C = ('\t'); C = ('\n');
C = ('\v'); C = ('\f'); C = ('\r')).
is_digit(C) :-
(C = ('0'); C = ('1'); C = ('2'); C = ('3'); C = ('4');
C = ('5'); C = ('6'); C = ('7'); C = ('8'); C = ('9')).
drop_spaces([], Lst) :-
Lst = [].
drop_spaces([C | Tail], Lst) :-
(is_space(C)
-> drop_spaces(Tail, Lst)
; Lst = [C | Tail]).
drop_nondigits([], Lst) :-
Lst = [].
drop_nondigits([C | Tail], Lst) :-
(is_digit(C)
-> Lst = [C | Tail]
; drop_nondigits(Tail, Lst)).
split_nonspaces([], Word, Rest) :-
(Word = [], Rest = []).
split_nonspaces([C | Tail], Word, Rest) :-
(is_space(C)
-> (Word = [], Rest = [C | Tail])
; (split_nonspaces(Tail, Word1, Rest),
Word = [C | Word1])).
split_digits([], Digits, Rest) :-
(Digits = [], Rest = []).
split_digits([C | Tail], Digits, Rest) :-
(is_digit(C)
-> (split_digits(Tail, Digits1, Rest),
Digits = [C | Digits1])
; (Digits = [], Rest = [C | Tail])).
split_before_char(_, [], Before, After) :-
(Before = [], After = []).
split_before_char(C, [C1 | Rest], Before, After) :-
(C = C1
-> (Before = [], After = [C1 | Rest])
; (split_before_char(C, Rest, Before1, After),
Before = [C1 | Before1])).
get_line(Stream, Line, Terminal) :-
% Reads a line of input as a list of characters. The character that
% terminates the line is returned separately; it may be either '\n'
% or end_of_file.
get_line_chars(Stream, [], Line, Terminal).
get_line_chars(Stream, Chars0, Chars, Terminal) :-
% Helper predicate for get_line.
get_char(Stream, C),
((C = end_of_file; C = ('\n'))
-> (reverse(Chars0, Chars), Terminal = C)
; get_line_chars(Stream, [C | Chars0], Chars, Terminal)).
main(Args) :-
(Args = []
-> current_input(Input),
current_output(Output),
make_and_run_machine(Input, Output)
; (Args = [Inp_Name]
-> (Inp_Name = ('-')
-> main([])
; (open(Inp_Name, 'read', Input),
current_output(Output),
make_and_run_machine(Input, Output),
close(Input)))
; (Args = [Inp_Name, Out_Name | _],
(Inp_Name = ('-')
-> (Out_Name = ('-')
-> main([])
; (current_input(Input),
open(Out_Name, 'write', Output),
make_and_run_machine(Input, Output),
close(Output)))
; (Out_Name = ('-')
-> main([Inp_Name])
; (open(Inp_Name, 'read', Input),
open(Out_Name, 'write', Output),
make_and_run_machine(Input, Output),
close(Input),
close(Output))))))).
main :-
argument_list(Args),
main(Args).
:- initialization(main).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Instructions for GNU Emacs--
%%% local variables:
%%% mode: prolog
%%% prolog-indent-width: 2
%%% end:
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Reference in a new issue View git blame Copy permalink