changeset 99c955178814 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=99c955178814 user: Simon Forman <sform****@hushm*****> date: Fri Nov 08 14:06:28 2019 -0800 description: Cons changeset 25f172ec5171 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=25f172ec5171 user: Simon Forman <sform****@hushm*****> date: Fri Nov 08 15:24:09 2019 -0800 description: Minor bugfix. asr not ror. changeset 72eb2cea8529 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=72eb2cea8529 user: Simon Forman <sform****@hushm*****> date: Sat Nov 09 11:27:29 2019 -0800 description: Minor cleanup, bug fixes. changeset 384170d89738 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=384170d89738 user: Simon Forman <sform****@hushm*****> date: Sat Nov 09 12:03:13 2019 -0800 description: That's the mainloop converted to permit negative offsets. changeset 1aa5dd872299 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=1aa5dd872299 user: Simon Forman <sform****@hushm*****> date: Sat Nov 09 12:14:51 2019 -0800 description: I think that does it for cons. Offsets in pair records can be negative. changeset 8b9540cc26e8 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=8b9540cc26e8 user: Simon Forman <sform****@hushm*****> date: Sat Nov 09 13:34:51 2019 -0800 description: Convert to ⟐ DCG and it's macro-time! changeset f88395591fa8 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=f88395591fa8 user: Simon Forman <sform****@hushm*****> date: Sat Nov 09 13:42:14 2019 -0800 description: That works nicely, again. changeset b4af435a7b08 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=b4af435a7b08 user: Simon Forman <sform****@hushm*****> date: Sat Nov 09 13:59:06 2019 -0800 description: Refactoring, with oddball quoting "symbols". changeset e3f6283e538c in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=e3f6283e538c user: Simon Forman <sform****@hushm*****> date: Sat Nov 09 14:02:18 2019 -0800 description: Minor refactor. changeset 0747b3610ed1 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=0747b3610ed1 user: Simon Forman <sform****@hushm*****> date: Sat Nov 09 15:03:17 2019 -0800 description: unpack_pair changeset a39d15e95f64 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=a39d15e95f64 user: Simon Forman <sform****@hushm*****> date: Sat Nov 09 15:12:44 2019 -0800 description: Base address in unpack_pair. changeset b3e314788a3d in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=b3e314788a3d user: Simon Forman <sform****@hushm*****> date: Sat Nov 09 15:20:06 2019 -0800 description: Bleah. changeset f04de4e39891 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=f04de4e39891 user: Simon Forman <sform****@hushm*****> date: Sat Nov 09 18:02:07 2019 -0800 description: load changeset 8f5564bde611 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=8f5564bde611 user: Simon Forman <sform****@hushm*****> date: Sat Nov 09 18:15:56 2019 -0800 description: Refactoring and cleanup. changeset cf2f20b49a2c in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=cf2f20b49a2c user: Simon Forman <sform****@hushm*****> date: Sat Nov 09 18:28:01 2019 -0800 description: incr stack Really decr, but I'm abstracting. changeset 9b1815aa90f9 in joypy/Joypy details: http://hg.osdn.jp/view/joypy/Joypy?cmd=changeset;node=9b1815aa90f9 user: Simon Forman <sform****@hushm*****> date: Sat Nov 09 18:39:39 2019 -0800 description: if_literal and lookup diffstat: thun/asm-dump.txt | 97 ++++++++++++++++++++++++ thun/compiler.markII.pl | 188 ++++++++++++++++++++++++++++++++--------------- thun/joy_asm.bin | Bin thun/joy_asmii.bin | Bin thun/markII.rst | 104 ++++++++++++++++++++++++++ 5 files changed, 328 insertions(+), 61 deletions(-) diffs (truncated from 455 to 300 lines): diff -r fa99e0be2382 -r 9b1815aa90f9 thun/asm-dump.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/thun/asm-dump.txt Sat Nov 09 18:39:39 2019 -0800 @@ -0,0 +1,97 @@ +[word(0), +do_offset(_7910), +allocate(_7920,20), +label(_7910), +mov_imm(0,0), +store_word(0,0,0), +mov_imm(0,4096), +mov_imm(1,_7982), +mov_imm(2,0), +mov_imm(3,0), +store_word(2,0,0), +label(_8030), +sub_imm(1,1,0), +eq_offset(_8042), +load_word(4,1,0), +lsl_imm(5,4,2), +asr_imm(5,5,17), +eq_offset(_8158), +add(5,5,1), +label(_8158), +lsl_imm(6,4,17), +asr_imm(6,6,17), +eq_offset(_8220), +add(6,6,1), +label(_8220), +load_word(3,5,0), +mov(1,6), +asr_imm(6,3,30), +and_imm(6,6,2), +sub_imm(6,6,2), +ne_offset(_8322), +mov_imm_with_shift(6,16383), +ior_imm(6,6,65535), +and(6,6,3), +do(6), +label(_8322), +sub_imm(0,0,4), +sub(2,5,0), +hi_offset(_8424), +and_imm(2,2,32767), +label(_8424), +lsl_imm(2,2,15), +ior_imm(2,2,4), +label(_8486), +store_word(2,0,0), +do_offset(_8030), +label(_8042), +do_offset(_8042), +label(_8540), +lsl_imm(6,2,2), +asr_imm(6,6,17), +eq_offset(_8656), +add(6,6,0), +label(_8656), +lsl_imm(2,2,17), +asr_imm(2,2,17), +eq_offset(_8718), +add(2,2,0), +label(_8718), +load_word(7,2,0), +lsl_imm(8,7,2), +asr_imm(8,8,17), +eq_offset(_8794), +add(8,8,2), +label(_8794), +lsl_imm(9,7,17), +asr_imm(9,9,17), +eq_offset(_8856), +add(9,9,2), +label(_8856), +sub_imm(0,0,4), +sub_imm(8,8,0), +eq_offset(_8900), +sub(8,8,0), +and_imm(8,8,32767), +label(_8900), +sub_imm(6,6,0), +eq_offset(_8968), +sub(6,6,0), +and_imm(6,6,32767), +label(_8968), +lsl_imm(8,8,15), +ior(8,8,6), +store_word(8,0,0), +sub_imm(0,0,4), +sub_imm(9,9,0), +eq_offset(_9114), +sub(9,9,0), +and_imm(9,9,32767), +label(_9114), +mov_imm_with_shift(2,2), +ior(2,2,9), +do_offset(_8486), +label(_7982), +expr_cell(_9232,0), +label(_9232), +symbol(_8540)] \ No newline at end of file diff -r fa99e0be2382 -r 9b1815aa90f9 thun/compiler.markII.pl --- a/thun/compiler.markII.pl Fri Nov 08 08:08:53 2019 -0800 +++ b/thun/compiler.markII.pl Sat Nov 09 18:39:39 2019 -0800 @@ -25,97 +25,161 @@ % Just do it in assembler. - -program([ % Mainloop. +⟐(program) --> + { [SP, EXPR_addr, TOS, TERM, EXPR, TermAddr, TEMP0, TEMP1, TEMP2, TEMP3] + = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9 ] + }, + [ % Mainloop. + word(0), % Zero root cell. + do_offset(Reset), % Oberon bootloader writes MemLim to RAM[12] and + allocate(_, 20), % stackOrg to RAM[24], we don't need these + label(Reset), % but they must not be allowed to corrupt our code. - do_offset(Over), % Oberon bootloader writes MemLim to RAM[12] and - allocate(_, 16), % stackOrg to RAM[24], we don't need these - label(Over), % but they must not be allowed to corrupt our code. - - mov_imm(0, 0), % zero out the root cell. + mov_imm(0, 0), % zero out the root cell. (After reset.) store_word(0, 0, 0), mov_imm(SP, 0x1000), - mov_imm(EXPR_addr, 0x500), + mov_imm(EXPR_addr, Expression), mov_imm(TOS, 0), mov_imm(TERM, 0), store_word(TOS, SP, 0), % RAM[SP] := 0 - label(Main), - - % if_zero(EXPR_addr, HALT), - sub_imm(EXPR_addr, EXPR_addr, 0), - eq_offset(HALT), - - % deref(EXPR_addr, EXPR), - load_word(EXPR, EXPR_addr, 0), % Load expr pair record into EXPR - + label(Main) +],⟐([ + if_zero(EXPR_addr, HALT), + load(EXPR, EXPR_addr), % At this point EXPR holds the record word of the expression. - - ror_imm(TermAddr, EXPR, -15), % put the offset in TermAddr - % No need to mask off high bits as the type tag for pairs is 00 - - add(TermAddr, TermAddr, EXPR_addr), - + unpack_pair(EXPR, TermAddr, TEMP0, EXPR_addr), + load(TERM, TermAddr) +]),[ % TermAddr has the address of the term record. - - load_word(TERM, TermAddr, 0), % Bring the record in from RAM. - - % Now Term has the term's record data and TermAddr has the address of the term. - - and_imm(TEMP0, EXPR, 0x7fff), % get the offset of the tail of the expr - eq_offset(Foo), % if the offset is zero don't add the adress. it's empty list. - add(TEMP0, TEMP0, EXPR_addr), % Add the address to the offset. - label(Foo), - mov(EXPR_addr, TEMP0), - + % Now TERM has the term's record data and TermAddr has the address of the term. + mov(EXPR_addr, TEMP0) % EXPR_addr now holds the address of the next cell of the expression list. - - % if_literal(TERM, PUSH), - ror_imm(TEMP0, TERM, -30), % get just the two tag bits. - sub_imm(TEMP0, TEMP0, 2), % if this is a symbol result is zero. - ne_offset(PUSH), - +],⟐([ + if_literal(TERM, PUSH, TEMP0), % if it is a symbol the rest of it is the pointer to the machine code. - % lookup(TERM), % Jump to command. - mov_imm_with_shift(TEMP0, 0x3fff), % TEMP0 = 0x3fffffff - ior_imm(TEMP0, TEMP0, 0xffff), - and(TEMP0, TEMP0, TERM), - eq(TEMP0), % double check that this works with pointer in reg... - + lookup(TERM, TEMP0) % Jump to command. +]),[ % going into push we have the term - label(PUSH), + label(PUSH) % push2(TOS, TEMP1, SP), % stack = TERM, stack - - sub_imm(SP, SP, 4), % SP -= 1 (word, not byte) +],⟐( + incr(SP) +),[ % SP points to the future home of the new stack cell. sub(TOS, TermAddr, SP), % TOS := &temp - sp + % Er, what if it's negative? + hi_offset(Bar0), + and_imm(TOS, TOS, 0x7fff), % Mask off high bits so + label(Bar0), % they won't interfere with making a record cell. % TOS has the offset from new stack cell to term cell. % Combine with the offset to the previous stack cell. lsl_imm(TOS, TOS, 15), % TOS := TOS << 15 - ior(TOS, TOS, 4), % TOS := TOS | 4 + ior_imm(TOS, TOS, 4), % TOS := TOS | 4 - % label(DONE), + label(Done), store_word(TOS, SP, 0), % RAM[SP] := TOS do_offset(Main), - label(HALT), - do_offset(HALT) -]) :- [SP, EXPR_addr, TOS, TERM, EXPR, TermAddr, TEMP0]=[0, 1, 2, 3, 4, 5, 6]. + label(HALT), % This is a HALT loop, the emulator detects and traps + do_offset(HALT), % on this "10 goto 10" instruction. + +% ====================================== + + label(Cons) % Let's cons. +],⟐([ + unpack_pair(TOS, TEMP0, TOS, SP), + % TEMP0 = Address of the list to which to append. + % TOS = Address of the second stack cell. + load(TEMP1, TOS), + % TEMP1 contains the record of the second stack cell. + unpack_pair(TEMP1, TEMP2, TEMP3, TOS), + % TEMP2 contains the address of the second item on the stack + % TEMP3 = TOS + TEMP1[15:0] the address of the third stack cell + + % Build and write the new list cell. + incr(SP), + sub_base_from_offset(TEMP2, SP), + sub_base_from_offset(TEMP0, SP) +]),[ + lsl_imm(TEMP2, TEMP2, 15), % TEMP2 := TEMP2 << 15 + ior(TEMP2, TEMP2, TEMP0), + store_word(TEMP2, SP, 0) +],⟐([ + incr(SP), + sub_base_from_offset(TEMP3, SP) +]),[ + mov_imm_with_shift(TOS, 2), % TOS := 4 << 15 + ior(TOS, TOS, TEMP3), + do_offset(Done), % Rely on mainloop::Done to write TOS to RAM. + + label(Expression), + expr_cell(ConsSym, 0), + label(ConsSym), symbol(Cons) + +]. + +/* + +This stage ⟐//1 converts the intermediate representation to assembly +language. + +*/ + +⟐([]) --> []. +⟐([Term|Terms]) --> ⟐(Term), ⟐(Terms). + +⟐(if_zero(Reg, Label)) --> [sub_imm(Reg, Reg, 0), eq_offset(Label)]. + +⟐(sub_base_from_offset(Reg, Base)) --> + ⟐(if_zero(Reg, Label)), % if the offset is zero don't subtract + [sub(Reg, Reg, Base), % the Base address, it's the empty list. + and_imm(Reg, Reg, 0x7fff), % Mask off high bits. + label(Label)]. + +⟐(unpack_pair(From, HeadAddr, TailAddr, Base)) --> + [lsl_imm(HeadAddr, From, 2), % Trim off the type tag 00 bits. + asr_imm(HeadAddr, HeadAddr, 17), % HeadAddr := From >> 15 + eq_offset(Label0), % if the offset is zero don't add the address. it's empty list. + add(HeadAddr, HeadAddr, Base), + label(Label0), + lsl_imm(TailAddr, From, 17), % Get the offset of the third stack cell + asr_imm(TailAddr, TailAddr, 17), % while preserving the sign. + eq_offset(Label1), % if the offset is zero don't add the address. it's empty list. + add(TailAddr, TailAddr, Base), + label(Label1)]. + +⟐(load(From, To)) --> [load_word(From, To, 0)]. + +⟐(incr(SP)) --> [sub_imm(SP, SP, 4)]. % SP -= 1 (word, not byte). + +⟐(if_literal(TERM, Push, TEMP)) --> + [asr_imm(TEMP, TERM, 30), % get just the two tag bits. + and_imm(TEMP, TEMP, 2), % mask the two tag bits. + sub_imm(TEMP, TEMP, 2), % if this is a symbol result is zero. + ne_offset(Push)]. + +⟐(lookup(TERM, TEMP)) --> + % if it is a symbol the rest of it is the pointer to the machine code.
Fork