changeset 9c936d045ba7 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=9c936d045ba7 user: Simon Forman <sform****@hushm*****> date: Sat Aug 10 19:25:48 2019 -0700 description: Rename foo to thun. changeset dd689c148af6 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=dd689c148af6 user: Simon Forman <sform****@hushm*****> date: Sat Aug 10 19:57:00 2019 -0700 description: Fold in parser, main loop, and support. changeset 67df8fddce5d in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=67df8fddce5d user: Simon Forman <sform****@hushm*****> date: Sat Aug 10 20:03:52 2019 -0700 description: Do not need thses files. changeset a71525e87b9b in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=a71525e87b9b user: Simon Forman <sform****@hushm*****> date: Sat Aug 10 20:06:12 2019 -0700 description: Omit Prolog toplevel. diffstat: .hgignore | 3 +- thun/gnu-prolog/Makefile | 6 +- thun/gnu-prolog/build.sh | 1 - thun/gnu-prolog/compiler.pl | 681 ----------------------------------------- thun/gnu-prolog/foo.pl | 107 ------ thun/gnu-prolog/metalogical.pl | 84 ----- thun/gnu-prolog/swi-thun.pl | 350 +++++++++++++++++++++ thun/gnu-prolog/thun.pl | 314 ++++-------------- thun/gnu-prolog/util.pl | 37 -- 9 files changed, 423 insertions(+), 1160 deletions(-) diffs (truncated from 1673 to 300 lines): diff -r ec075de4ce6c -r a71525e87b9b .hgignore --- a/.hgignore Sat Aug 10 12:19:09 2019 -0700 +++ b/.hgignore Sat Aug 10 20:06:12 2019 -0700 @@ -1,7 +1,8 @@ .*\.pyc$ +.*\.swp$ .hypothesis .pytest_cache .vscode docs/.ipynb_checkpoints test/* - +thun diff -r ec075de4ce6c -r a71525e87b9b thun/gnu-prolog/Makefile --- a/thun/gnu-prolog/Makefile Sat Aug 10 12:19:09 2019 -0700 +++ b/thun/gnu-prolog/Makefile Sat Aug 10 20:06:12 2019 -0700 @@ -1,8 +1,6 @@ - +GPLC_OPTIONS="--min-size" thun: thun.pl - gplc -o thun thun.pl + gplc $(GPLC_OPTIONS) -o thun thun.pl -foo: foo.pl - gplc -o foo foo.pl diff -r ec075de4ce6c -r a71525e87b9b thun/gnu-prolog/build.sh --- a/thun/gnu-prolog/build.sh Sat Aug 10 12:19:09 2019 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1 +0,0 @@ -gplc --min-size -o thun thun.pl util.pl diff -r ec075de4ce6c -r a71525e87b9b thun/gnu-prolog/compiler.pl --- a/thun/gnu-prolog/compiler.pl Sat Aug 10 12:19:09 2019 -0700 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,681 +0,0 @@ -/* - -Copyright © 2018-2019 Simon Forman - -This file is part of Thun - -Thun is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. - -Thun is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with Thun. If not see <http://www.gnu.org/licenses/>. - -The Joy interpreter that this implements is pretty crude. the only types -are 16-bit integers and linked lists. The lists are 32-bit words divided -into two 16-bit fields. The high half is the node value and the low half -points directly (not offset) to the next cell, zero terminates the list. - -The expression is expected to be already written in RAM as a linked list at -the time the mainloop starts. As yet there is no support for actually doing -this. Both the new stack and expression cells are written to the same heap -intermixed. The stack and expression pointers never decrease, the whole -history of the computation is recorded in RAM. If the computation of the -expression overruns the end of RAM (or 16-bits whichever comes first) the -machine crashes. - -At the moment, functions are recognized by setting high bit, but I don't -think I remembered to set the bits during compilation, so it won't work -at all right now. Er... Boo. Anyhow, the whole thing is very crude and -not at all what I am hoping eventually to build. - -But it's a start, and I feel good about emitting machine code (even if the -program doesn't do anything useful yet.) - -*/ -:- use_module(library(assoc)). -:- use_module(library(clpfd)). - - -do :- Program = [ - ヲ,∅,⟴,ヵ,メ,ョ, - [グ,ケ,ゲ,ド,ゴ,サ],ヮ(cons), - [ザ,シ],ヮ(dup), - [グ,ス,[],[ジ,ス,[ズ,セ,ス,[ゼ,ソ],[タ,ゾ],ヰ,ヂ],ヱ],ヰ,チ],ヮ(i), - [ヶ,ペ],ワ(new), - [ナ,ズ,セ,ネ,ヒ,ド,ャ,ペ],ワ(swap), - [new,cons],≡(unit), - [dup,i],≡(x), - [swap,cons],≡(swons) - ], -compile_program(Program, Binary), -write_binary('joy_asm.bin', Binary). - - -compile_program(Program, Binary) :- - phrase((init, ⦾(Program, IR)), [], [Context]), - phrase(⟐(IR), ASM), - phrase(linker(ASM), EnumeratedASM), - foo(Context), - phrase(asm(EnumeratedASM), Binary). - -foo(Context) :- - get_assoc(dictionary, Context, D), - assoc_to_list(D, Dictionary), - portray_clause(Dictionary). - - -/* - -This first stage ⦾//2 converts the Joy description into a kind of intermediate -representation that models the Joy interpreter on top of the machine but doesn't -actually use assembly instructions. It also manages the named registers and -memory locations so thet don't appear in the program. - -The idea here is to extract the low-level "primitives" needed to define the Joy -interpreter to make it easier to think about (and maybe eventually retarget other -CPUs.) - - */ - -⦾([], []) --> []. - -⦾([ヲ|Terms], Ts) --> % Preamble. - % Initialize context/state/symbol table. - set(dict_ptr, 11), % Reg 11 is a pointer used during func lookup. - set(dict_top, 12), % Reg 12 points to top of dictionary. - set(dict, 0), % Address of top of dict during compilation. - set(done, _DONE), % DONE label (logic variable.) - set(expr, 4), % Reg 4 points to expression. - set(halt, _HALT), % HALT label (logic variable.) - set(main, _MAIN), % MAIN label (logic variable.) - set(reset, _Reset), % Reset label (logic variable.) - set(sp, 2), % Reg 2 points to just under top of stack. - set(temp0, 6), % Reg 6 is a temp var. - set(temp1, 7), % Reg 7 is a temp var. - set(temp2, 8), % Reg 8 is a temp var. - set(temp3, 9), % Reg 9 is a temp var. - set(term, 5), % Reg 4 holds current term. - set(tos, 3), % Reg 3 holds Top of Stack. - ⦾(Terms, Ts). - -⦾([ヵ|Terms], [ % Initialization. - jump(Over), % Oberon bootloader writes MemLim to RAM[12] and - asm(allocate(_, 16)), % stackOrg to RAM[24], we don't need these - label(Over), % but they must not be allowed to corrupt our code. - set_reg_const(0, 0), % zero out the root cell. - write_ram(0, 0), - set_reg_const(SP, 0x1000), - set_reg_const(EXPR, 0x500), - set_reg_label(DICT_TOP, LastWord), - set_reg_const(TOS, 0), - set_reg_const(TERM, 0), - asm(store_word(TOS, SP, 0)) % RAM[SP] := 0 - |Ts]) --> - get([dict_top, DICT_TOP, expr, EXPR, sp, SP, term, TERM, tos, TOS]), - ⦾(Terms, Ts), get(dict, LastWord). - -⦾([メ|Terms], [ % Mainloop. - label(MAIN), - if_zero(EXPR, HALT), - deref(EXPR), - split_word(TERM, EXPR), - if_literal(TERM, PUSH), - lookup(DICT_PTR, DICT_TOP, TERM, HALT), % Jump to command or if not found halt. - label(PUSH), push(TOS, TERM, SP), % stack = TERM, stack - label(DONE), write_ram(SP, TOS), % RAM[SP] := TOS - jump(MAIN) - |Ts]) --> - get([dict_ptr, DICT_PTR, dict_top, DICT_TOP, done, DONE, expr, EXPR, - halt, HALT, main, MAIN, sp, SP, term, TERM, tos, TOS]), - ⦾(Terms, Ts). - -⦾([Body, ≡(NameAtom)|Terms], [defi(Name, B, Prev, I, SP, TOS)|Ts]) --> - get(dict, Prev), set(dict, Name), get([sp, SP, tos, TOS]), - inscribe(NameAtom, Name), ⦾(Terms, Ts), lookup(i, I), lookup(Body, B). - -⦾([Body, ヮ(NameAtom)|Terms], [definition(Name, DONE, B, Prev)|Ts]) --> - get(dict, Prev), set(dict, Name), inscribe(NameAtom, Name), - get(done, DONE), ⦾([Body, Terms], [B, Ts]). - -⦾([Body, ワ(NameAtom)|Terms], [definition(Name, MAIN, B, Prev)|Ts]) --> - get(dict, Prev), set(dict, Name), inscribe(NameAtom, Name), - get(main, MAIN), ⦾([Body, Terms], [B, Ts]). - -⦾([P, T, E, ヰ|Terms], [br(Predicate, Then, Else)|Ts]) --> - ⦾([P, T, E, Terms], [Predicate, Then, Else, Ts]). - -⦾([P, B, ヱ|Terms], [repeat_until(Predicate, Body)|Ts]) --> - ⦾([P, B, Terms], [Predicate, Body, Ts]). - -⦾([Term|Terms], [T|Ts]) --> ⦾(Term, T), ⦾(Terms, Ts). - -⦾(∅, dw(0)) --> []. -⦾(⟴, label(Reset)) --> get(reset, Reset). -⦾(ョ, halt(HALT)) --> get(halt, HALT). -⦾(グ, pop(TEMP0, TOS)) --> get(temp0, TEMP0), get(tos, TOS). -⦾(シ, push(TOS, TOS, SP)) --> get(tos, TOS), get(sp, SP). -⦾(ケ, high_half(TEMP1, TOS)) --> get(temp1, TEMP1), get(tos, TOS). -⦾(サ, merge(SP, TOS)) --> get(tos, TOS), get(sp, SP). -⦾(ザ, swap_halves(TOS)) --> get(tos, TOS). -⦾(ズ, deref(TEMP0)) --> get(temp0, TEMP0). -⦾(ス, if_zero(TEMP0)) --> get(temp0, TEMP0). -⦾(ソ, asm(mov(EXPR, TEMP3))) --> get(expr, EXPR), get(temp3, TEMP3). -⦾(ャ, asm(ior(TOS, TEMP1, SP))) --> get(tos, TOS), get(temp1, TEMP1), get(sp, SP). -⦾(タ, add_const(TEMP2, SP, 8)) --> get(temp2, TEMP2), get(sp, SP). -⦾(ジ, add_const(TEMP3, SP, 4)) --> get(temp3, TEMP3), get(sp, SP). -⦾(チ, add_const(SP, SP, 4)) --> get(sp, SP). -⦾(セ, chop_word(TEMP1, TEMP0)) --> get(temp0, TEMP0), get(temp1, TEMP1). -⦾(ト, chop_word(TEMP0, TOS)) --> get(temp0, TEMP0), get(tos, TOS). -⦾(ネ, chop_word(TEMP2, TOS)) --> get(temp2, TEMP2), get(tos, TOS). -⦾(ゼ, or_inplace(TEMP1, EXPR)) --> get(expr, EXPR), get(temp1, TEMP1). -⦾(ゲ, or_inplace(TEMP0, TEMP1)) --> get(temp0, TEMP0), get(temp1, TEMP1). -⦾(ヒ, or_inplace(TEMP0, TEMP2)) --> get(temp0, TEMP0), get(temp2, TEMP2). -⦾(ゾ, or_inplace(TEMP1, TEMP2)) --> get(temp1, TEMP1), get(temp2, TEMP2). -⦾(ド, write_cell(TEMP0, SP)) --> get(temp0, TEMP0), get(sp, SP). -⦾(ヂ, write_cell(TEMP1, SP)) --> get(temp1, TEMP1), get(sp, SP). -⦾(ペ, write_cell(TOS, SP)) --> get(tos, TOS), get(sp, SP). -⦾(ゴ, low_half(TOS)) --> get(tos, TOS). -⦾(ナ, low_half(TEMP0, TOS)) --> get(temp0, TEMP0), get(tos, TOS). -⦾(ヶ, low_half(TOS, SP)) --> get(sp, SP), get(tos, TOS). - - -/* - -Context (state) manipulation for the ⦾//2 relation. - -Association lists are used to keep a kind of symbol table as well as a dictionary -of name atoms to address logic variables for defined Joy functions. - -*/ - -init, [Context] --> - {empty_assoc(C), empty_assoc(Dictionary), - put_assoc(dictionary, C, Dictionary, Context)}. - -get([]) --> !. -get([Key, Value|Ts]) --> !, get(Key, Value), get(Ts). - -get(Key, Value) --> state(Context), {get_assoc(Key, Context, Value)}. -set(Key, Value) --> state(ContextIn, ContextOut), - {put_assoc(Key, ContextIn, Value, ContextOut)}. - -inscribe(NameAtom, Label) --> state(ContextIn, ContextOut), - {get_assoc(dictionary, ContextIn, Din), - put_assoc(NameAtom, Din, Label, Dout), - put_assoc(dictionary, ContextIn, Dout, ContextOut)}. - -lookup([], []) --> !. -lookup([T|Ts], [V|Vs]) --> !, lookup(T, V), lookup(Ts, Vs). -lookup(NameAtom, Label) --> state(Context), - {get_assoc(dictionary, Context, D), get_assoc(NameAtom, D, Label)}. - -state(S), [S] --> [S]. -state(S0, S), [S] --> [S0]. - - -/* - -This second stage ⟐//1 converts the intermediate representation to assembly -language. - -*/ - -⟐([]) --> []. -⟐([Term|Terms]) --> ⟐(Term), ⟐(Terms). - -⟐(if_literal(Reg, Label)) --> % commands marked by setting high bit. - [and_imm(0, Reg, 0x8000), % 1 << 15 - eq_offset(Label)]. - -% if reg = 0 jump to label. -⟐(if_zero(Reg, Label)) --> [sub_imm(Reg, Reg, 0), eq_offset(Label)]. - -⟐(set_reg_const(Reg, Immediate)) --> {Immediate >= -(2^15), Immediate < 2^16}, !, - [mov_imm(Reg, Immediate)]. - -⟐(set_reg_const(Reg, Immediate)) --> {Immediate >= 0, Immediate < 2^33}, !, % FIXME: handle negative numbers. - {high_half_word(Immediate, HighHalf), low_half_word(Immediate, LowHalf)}, - [ mov_imm_with_shift(Reg, HighHalf), ior_imm(Reg, Reg, LowHalf)]. - -⟐(set_reg_label(Reg, Label)) --> [mov_imm(Reg, Label)]. - -⟐( noop) --> [mov(0, 0)]. -⟐( halt(Halt)) --> [label(Halt), do_offset(Halt)]. -⟐( asm(ASM)) --> [ASM]. -⟐(label(Label)) --> [label(Label)]. -⟐( jump(Label)) --> [do_offset(Label)]. -⟐( dw(Int)) --> [word(Int)]. - -⟐( low_half(Reg)) --> [and_imm(Reg, Reg, 0xffff)]. -⟐( low_half(To, From)) --> [and_imm(To, From, 0xffff)]. -⟐( high_half(Reg)) --> [mov_imm_with_shift(0, 0xffff), and(Reg, Reg, 0)]. -⟐(high_half(To, From)) --> [mov_imm_with_shift(0, 0xffff), and(To, From, 0)]. - -⟐(swap_halves(Register)) --> [ror_imm(Register, Register, 16)]. -⟐(swap_halves(To, From)) --> [ror_imm( To, From, 16)]. - -⟐(high_half_to(To, From)) --> ⟐([swap_halves(To, From), low_half(To)]).
Fork