diff --git a/thun/asm-dump.txt b/thun/asm-dump.txt index 7a60572..c9a85ca 100644 --- a/thun/asm-dump.txt +++ b/thun/asm-dump.txt @@ -5,7 +5,7 @@ label(A), mov_imm(0, 0), store_word(0, 0, 0), mov_imm(0, 4096), -mov_imm(1, S), +mov_imm(1, I1), mov_imm(2, 0), mov_imm(3, 0), store_word(2, 0, 0), @@ -103,4 +103,86 @@ lsl_imm(5, 2, 2), asr_imm(5, 5, 17), do_offset(D), label(S), -expr_cell(R, 0)]. +symbol(S), +lsl_imm(6, 2, 2), +asr_imm(6, 6, 17), +eq_offset(T), +add(6, 6, 0), +label(T), +lsl_imm(2, 2, 17), +asr_imm(2, 2, 17), +eq_offset(U), +add(2, 2, 0), +label(U), +sub_imm(6, 6, 0), +eq_offset(D1), +sub_imm(10, 0, 4), +mov_imm(9, 4), +label(B1), +load_word(3, 6, 0), +lsl_imm(7, 3, 2), +asr_imm(7, 7, 17), +eq_offset(V), +add(7, 7, 6), +label(V), +lsl_imm(8, 3, 17), +asr_imm(8, 8, 17), +eq_offset(W), +add(8, 8, 6), +label(W), +mov(6, 8), +sub_imm(0, 0, 4), +sub_imm(8, 8, 0), +eq_offset(X), +lsl_imm(7, 7, 15), +ior(7, 7, 9), +store_word(7, 0, 0), +do_offset(A1), +label(X), +sub_imm(7, 7, 0), +eq_offset(Y), +sub(7, 7, 0), +and_imm(7, 7, 32767), +label(Y), +sub_imm(1, 1, 0), +eq_offset(Z), +sub(1, 1, 0), +and_imm(1, 1, 32767), +label(Z), +lsl_imm(7, 7, 15), +ior(7, 7, 1), +store_word(7, 0, 0), +label(A1), +sub_imm(6, 6, 0), +eq_offset(C1), +do_offset(B1), +label(C1), +mov(1, 10), +label(D1), +load_word(7, 2, 0), +lsl_imm(6, 7, 2), +asr_imm(6, 6, 17), +eq_offset(E1), +add(6, 6, 2), +label(E1), +lsl_imm(7, 7, 17), +asr_imm(7, 7, 17), +eq_offset(F1), +add(7, 7, 2), +label(F1), +sub_imm(0, 0, 4), +sub_imm(6, 6, 0), +eq_offset(G1), +sub(6, 6, 0), +and_imm(6, 6, 32767), +label(G1), +sub_imm(7, 7, 0), +eq_offset(H1), +sub(7, 7, 0), +and_imm(7, 7, 32767), +label(H1), +lsl_imm(6, 6, 15), +ior(6, 6, 7), +store_word(6, 0, 0), +label(I1), +expr_cell(R, 0)]. \ No newline at end of file diff --git a/thun/compiler.markII.pl b/thun/compiler.markII.pl index 77fffd0..02fef20 100644 --- a/thun/compiler.markII.pl +++ b/thun/compiler.markII.pl @@ -26,8 +26,8 @@ Mark II % Just do it in assembler. ⟐(program) --> - { [SP, EXPR_addr, TOS, TERM, EXPR, TermAddr, TEMP0, TEMP1, TEMP2, TEMP3] - = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9 ] + { [SP, EXPR_addr, TOS, TERM, EXPR, TermAddr, TEMP0, TEMP1, TEMP2, TEMP3, TEMP4] + = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 ] }, [ word(0), % Zero root cell. @@ -49,13 +49,11 @@ Mark II load(EXPR, EXPR_addr), % At this point EXPR holds the record word of the expression. unpack_pair(EXPR, TermAddr, TEMP0, EXPR_addr), - load(TERM, TermAddr) -]),[ + load(TERM, TermAddr), % TermAddr has the address of the term record. % Now TERM has the term's record data and TermAddr has the address of the term. - mov(EXPR_addr, TEMP0) + asm(mov(EXPR_addr, TEMP0)), % EXPR_addr now holds the address of the next cell of the expression list. -],⟐([ if_literal(TERM, PUSH, TEMP0), % if it is a symbol the rest of it is the pointer to the machine code. lookup(TERM, TEMP0), % Jump to command. @@ -86,9 +84,9 @@ Mark II ],⟐([ - halt(HALT), % ====================================== + halt(HALT), - definition(Cons), % Let's cons. + definition(Cons), % ====================================== unpack_pair(TOS, TEMP0, TOS, SP), % TEMP0 = Address of the list to which to append. @@ -109,9 +107,61 @@ Mark II chain_link(TOS, TEMP3), jump(Done), % Rely on mainloop::Done to write TOS to RAM. - definition(Dup), + definition(Dup), % ====================================== head_addr(TOS, TermAddr), - jump(PUSH) + jump(PUSH), + + + definition(I), % ====================================== + + unpack_pair(TOS, TEMP0, TOS, SP), + % TEMP0 = Address of the quoted program. + % TOS = Address of the stack tail. + br(if_zero(TEMP0), [], % If the program is empty do nothing. + [ % The program has elements. Since we are going to be reading the q.p. + % from the head to the tail we will have to write the cells in that order. + incr(TEMP4, SP), % TEMP4 = address of head of eventual new expression. + asm(mov_imm(TEMP3, 4)), % Factored out of the loop. Used for linking. + repeat_until(if_zero(TEMP0), [ % TEMP0 = Address of the quoted program. + load(TERM, TEMP0), + unpack_pair(TERM, TEMP1, TEMP2, TEMP0), + % TEMP1 is the address of head item, TEMP2 is the tail + asm(mov(TEMP0, TEMP2)), % update temp0 to point to rest of quoted program. + incr(SP), % We are about to write a cell. + br(if_zero(TEMP2), + [ % TERM is the last item in the quoted program. + % The expr should point to a cell that has TEMP1 head and tail + % of the rest of the expression. + sub_base_from_offset(TEMP1, SP), + sub_base_from_offset(EXPR_addr, SP), + merge_and_store(TEMP1, EXPR_addr, SP) + ], [ % TERM has at least one more item after it. + % We know that we will be writing that item in a + % cell immediately after this one, so it has TEMP1 + % head and 4 for the tail. + merge_and_store(TEMP1, TEMP3, SP) + ] + ) + ]), + asm(mov(EXPR_addr, TEMP4)) + ]), + + % SP can never go down, so to point to an earlier cell we have to write + % a new cell. (Maybe use a separate heap register/pointer?) + load(TEMP1, TOS), % TEMP1 contains the record of the second stack cell. + % write a new cell, the head is head of TEMP1, the tail is tail of TEMP1 + % but adjusted to offset from SP+4 where we are about to write this record. + % Load tos with ram[tos] + unpack_pair(TEMP1, TEMP0, TEMP1, TOS), + % TEMP0 = HeadAddr, TEMP1 = TailAddr + incr(SP), + sub_base_from_offset(TEMP0, SP), + sub_base_from_offset(TEMP1, SP), + merge_and_store(TEMP0, TEMP1, SP) + + + + % ====================================== ]),[ label(Expression), expr_cell(Dup, 0) @@ -157,7 +207,11 @@ language. ⟐(halt(Halt)) --> [label(Halt), do_offset(Halt)]. % This is a HALT loop, the emulator detects and traps on this "10 goto 10" instruction. +⟐(asm(ASM)) --> [ASM]. + ⟐(incr(SP)) --> [sub_imm(SP, SP, 4)]. % SP -= 1 (word, not byte). +⟐(incr(To, SP)) --> [sub_imm(To, SP, 4)]. +⟐(incr(To, SP, N)) --> {M is 4 * N}, [sub_imm(To, SP, M)]. ⟐(if_literal(TERM, Push, TEMP)) --> [asr_imm(TEMP, TERM, 30), % get just the two tag bits. @@ -185,6 +239,41 @@ language. ⟐(head_addr(Pair, HeadAddr)) --> [lsl_imm(HeadAddr, Pair, 2), asr_imm(HeadAddr, HeadAddr, 17)]. +⟐(repeat_until(Condition, Body)) --> + {add_label(Condition, End, ConditionL)}, + ⟐([ + label(Loop), + Body, + ConditionL, + jump(Loop), + label(End) + ]). + +⟐(br(Condition, [], Else)) --> !, + {add_label(Condition, END, ConditionL)}, + ⟐([ConditionL, Else, label(END)]). + +⟐(br(Condition, Then, Else)) --> + {add_label(Condition, THEN, ConditionL)}, + ⟐([ + ConditionL, Else, jump(END), + label(THEN), Then, label(END) + ]). + + +/* + +The add_label/3 relation is a meta-logical construct that accepts a comparision +predicate (e.g. if_zero/2) and "patches" it by adding the Label logic variable +to the end. + +*/ + +add_label(CmpIn, Label, CmpOut) :- + CmpIn =.. F, + append(F, [Label], G), + CmpOut =.. G. + do :- compile_program(Binary), diff --git a/thun/joy_asmii.bin b/thun/joy_asmii.bin index 825da21..07f8a72 100644 Binary files a/thun/joy_asmii.bin and b/thun/joy_asmii.bin differ diff --git a/thun/markII.rst b/thun/markII.rst index c54aaaa..c1e2c54 100644 --- a/thun/markII.rst +++ b/thun/markII.rst @@ -321,14 +321,61 @@ the library code. シ push(TOS, TOS, SP) +------------------------------------ + + + [グ,ス,[],[ジ,ス,[ズ,セ,ス,[ゼ,ソ],[タ,ゾ],ヰ,ヂ],ヱ],ヰ,チ],ヮ(i), + + グ, pop(TEMP0, TOS) + ス, if_zero(TEMP0) + ジ, add_const(TEMP3, SP, 4) + ズ, deref(TEMP0) + セ, chop_word(TEMP1, TEMP0) + ゼ, or_inplace(TEMP1, EXPR) + ソ, asm(mov(EXPR, TEMP3)) + タ, add_const(TEMP2, SP, 8) + ゾ, or_inplace(TEMP1, TEMP2) + ヂ, write_cell(TEMP1, SP) + チ, add_const(SP, SP, 4) +⦾([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]). - - + [ + グ, pop(TEMP0, TOS) + ス, if_zero(TEMP0) + [], Then + [ Else + ジ, add_const(TEMP3, SP, 4) + ス, if_zero(TEMP0) + [ Body + ズ, deref(TEMP0) + セ, chop_word(TEMP1, TEMP0) + ス, if_zero(TEMP0) + [ Then + ゼ, or_inplace(TEMP1, EXPR) + ソ asm(mov(EXPR, TEMP3)) + ], + [ Else + タ, add_const(TEMP2, SP, 8) + ゾ or_inplace(TEMP1, TEMP2) + ], + ヰ, br(Predicate, Then, Else) + ヂ write_cell(TEMP1, SP) + ], + ヱ repeat_until(Predicate, Body) + ], + ヰ, br(Predicate, Then, Else) + チ add_const(SP, SP, 4) + ], + ヮ(i), PC == 0 PC == 0x25