changeset ec075de4ce6c in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=ec075de4ce6c user: Simon Forman <sform****@hushm*****> date: Sat Aug 10 12:19:09 2019 -0700 description: Make a version for GNU Prolog compiler. diffstat: thun/gnu-prolog/Makefile | 8 + thun/gnu-prolog/build.sh | 1 + thun/gnu-prolog/compiler.pl | 681 +++++++++++++++++++++++++++++++++++++++++ thun/gnu-prolog/defs.txt | 71 ++++ thun/gnu-prolog/foo.pl | 107 ++++++ thun/gnu-prolog/gthun.pl | 120 +++++++ thun/gnu-prolog/meta.pl | 10 + thun/gnu-prolog/metalogical.pl | 84 +++++ thun/gnu-prolog/thun.pl | 350 +++++++++++++++++++++ thun/gnu-prolog/util.pl | 37 ++ 10 files changed, 1469 insertions(+), 0 deletions(-) diffs (truncated from 1512 to 300 lines): diff -r bb69faf33d10 -r ec075de4ce6c thun/gnu-prolog/Makefile --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/thun/gnu-prolog/Makefile Sat Aug 10 12:19:09 2019 -0700 @@ -0,0 +1,8 @@ + + +thun: thun.pl + gplc -o thun thun.pl + +foo: foo.pl + gplc -o foo foo.pl + diff -r bb69faf33d10 -r ec075de4ce6c thun/gnu-prolog/build.sh --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/thun/gnu-prolog/build.sh Sat Aug 10 12:19:09 2019 -0700 @@ -0,0 +1,1 @@ +gplc --min-size -o thun thun.pl util.pl diff -r bb69faf33d10 -r ec075de4ce6c thun/gnu-prolog/compiler.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/thun/gnu-prolog/compiler.pl Sat Aug 10 12:19:09 2019 -0700 @@ -0,0 +1,681 @@ +/* + +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)]). + +⟐(split_word(To, From)) --> ⟐([high_half_to(To, From), low_half(From)]). + +⟐(chop_word(To, From)) --> ⟐([high_half(To, From), low_half(From)]). + +⟐(merge(SP, TOS)) --> + [lsl_imm(0, SP, 16), + ior(TOS, TOS, 0), + add_imm(SP, SP, 4)]. + +⟐(push(TOS, TERM, SP)) --> + [lsl_imm(TOS, TERM, 16), % TOS := TERM << 16 + ior(TOS, TOS, SP), % TOS := TOS | SP + add_imm(SP, SP, 4)]. % SP += 1 (word, not byte) +
Fork