% 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.
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.
],⟐([
- 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.
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)
⟐(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.
⟐(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),
シ push(TOS, TOS, SP)\r
\r
\r
+------------------------------------\r
\r
\r
-\r
-\r
-\r
-\r
-\r
-\r
+ [グ,ス,[],[ジ,ス,[ズ,セ,ス,[ゼ,ソ],[タ,ゾ],ヰ,ヂ],ヱ],ヰ,チ],ヮ(i),\r
+\r
+ グ, pop(TEMP0, TOS)\r
+ ス, if_zero(TEMP0)\r
+ ジ, add_const(TEMP3, SP, 4)\r
+ ズ, deref(TEMP0)\r
+ セ, chop_word(TEMP1, TEMP0)\r
+ ゼ, or_inplace(TEMP1, EXPR)\r
+ ソ, asm(mov(EXPR, TEMP3))\r
+ タ, add_const(TEMP2, SP, 8)\r
+ ゾ, or_inplace(TEMP1, TEMP2)\r
+ ヂ, write_cell(TEMP1, SP)\r
+ チ, add_const(SP, SP, 4)\r
+\r
+\r
+\r
+⦾([P, T, E, ヰ|Terms], [br(Predicate, Then, Else)|Ts]) -->\r
+ ⦾([P, T, E, Terms], [Predicate, Then, Else, Ts]).\r
+\r
+⦾([P, B, ヱ|Terms], [repeat_until(Predicate, Body)|Ts]) -->\r
+ ⦾([P, B, Terms], [Predicate, Body, Ts]).\r
+\r
+\r
+\r
+ [\r
+ グ, pop(TEMP0, TOS)\r
+ ス, if_zero(TEMP0)\r
+ [], Then\r
+ [ Else\r
+ ジ, add_const(TEMP3, SP, 4)\r
+ ス, if_zero(TEMP0)\r
+ [ Body\r
+ ズ, deref(TEMP0)\r
+ セ, chop_word(TEMP1, TEMP0)\r
+ ス, if_zero(TEMP0)\r
+ [ Then\r
+ ゼ, or_inplace(TEMP1, EXPR)\r
+ ソ asm(mov(EXPR, TEMP3))\r
+ ],\r
+ [ Else\r
+ タ, add_const(TEMP2, SP, 8)\r
+ ゾ or_inplace(TEMP1, TEMP2)\r
+ ],\r
+ ヰ, br(Predicate, Then, Else)\r
+ ヂ write_cell(TEMP1, SP)\r
+ ],\r
+ ヱ repeat_until(Predicate, Body)\r
+ ],\r
+ ヰ, br(Predicate, Then, Else)\r
+ チ add_const(SP, SP, 4)\r
+ ],\r
+ ヮ(i),\r
\r
PC == 0\r
PC == 0x25\r
OSDN Git Service
