The i combinator.

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)].

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]
+    { [SP, EXPR_addr, TOS, TERM, EXPR, TermAddr, TEMP0, TEMP1, TEMP2, TEMP3, TEMP4]
-    = [0,  1,         2,   3,    4,    5,        6,     7,     8,     9    ]
+    = [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),

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