unpack_pair

thun/asm-dump.txt

@@ -0,0 +1,97 @@
+[word(0),
+do_offset(_4074),
+allocate(_4084,20),
+label(_4074),
+mov_imm(0,0),
+store_word(0,0,0),
+mov_imm(0,4096),
+mov_imm(1,_4146),
+mov_imm(2,0),
+mov_imm(3,0),
+store_word(2,0,0),
+label(_4194),
+sub_imm(1,1,0),
+eq_offset(_4200),
+load_word(4,1,0),
+lsl_imm(5,4,2),
+asr_imm(5,5,17),
+eq_offset(_4276),
+add(5,5,1),
+label(_4276),
+load_word(3,5,0),
+lsl_imm(6,4,17),
+asr_imm(6,6,17),
+eq_offset(_4352),
+add(6,6,1),
+label(_4352),
+mov(1,6),
+asr_imm(6,3,30),
+and_imm(6,6,2),
+sub_imm(6,6,2),
+ne_offset(_4440),
+mov_imm_with_shift(6,16383),
+ior_imm(6,6,65535),
+and(6,6,3),
+do(6),
+label(_4440),
+sub_imm(0,0,4),
+sub(2,5,0),
+hi_offset(_4538),
+and_imm(2,2,32767),
+label(_4538),
+lsl_imm(2,2,15),
+ior_imm(2,2,4),
+label(_4600),
+store_word(2,0,0),
+do_offset(_4194),
+label(_4200),
+do_offset(_4200),
+label(_4654),
+lsl_imm(6,2,2),
+asr_imm(6,6,17),
+eq_offset(_4700),
+add(6,6,_4714),
+label(_4700),
+lsl_imm(2,2,17),
+asr_imm(2,2,17),
+eq_offset(_4762),
+add(2,2,_4714),
+label(_4762),
+load_word(7,2,0),
+lsl_imm(8,7,2),
+asr_imm(8,8,17),
+eq_offset(_4846),
+add(8,8,_4860),
+label(_4846),
+lsl_imm(9,7,17),
+asr_imm(9,9,17),
+eq_offset(_4908),
+add(9,9,_4860),
+label(_4908),
+sub_imm(0,0,4),
+sub_imm(8,8,0),
+eq_offset(_4976),
+sub(8,8,0),
+and_imm(8,8,32767),
+label(_4976),
+sub_imm(6,6,0),
+eq_offset(_5044),
+sub(6,6,0),
+and_imm(6,6,32767),
+label(_5044),
+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(_5174),
+sub(9,9,0),
+and_imm(9,9,32767),
+label(_5174),
+mov_imm_with_shift(2,2),
+ior(2,2,9),
+do_offset(_4600),
+label(_4146),
+expr_cell(_5292,0),
+label(_5292),
+symbol(_4654)]

thun/compiler.markII.pl

@@ -112,46 +112,19 @@ Mark II
 
 % ======================================
 
-    label(Cons),  % Let's cons.
+    label(Cons)],  % Let's cons.
 
-    lsl_imm(TEMP0, TOS, 2),  % Trim off the type tag 00 bits.
-    asr_imm(TEMP0, TEMP0, 17),  % TEMP0 := TOS >> 15
-    eq_offset(Foo1),  % if the offset is zero don't add the address. it's empty list.
-    add(TEMP0, TEMP0, SP),  % TEMP0 = SP + TOS[30:15]
-    label(Foo1),
+    ⟐(unpack_pair(TOS, TEMP0, TOS)),
     % TEMP0 = Address of the list to which to append.
-
-    lsl_imm(TOS, TOS, 17),  % Get the offset of the tail of the stack
-    asr_imm(TOS, TOS, 17),  % while preserving the sign.
-    eq_offset(Foo2),  % if the offset is zero don't add the address. it's empty list.
-    add(TOS, TOS, SP),  % TOS = SP + TOS[15:0]
-    label(Foo2),
     % TOS = Address of the second stack cell.
-
-    % the address of the second item on the stack is (TOS) + ram[TOS][30:15]
-    % the address of the third stack cell         is (TOS) + ram[TOS][15: 0]
-
-    load_word(TEMP1, TOS, 0),
+    [load_word(TEMP1, TOS, 0)],
     % TEMP1 contains the record of the second stack cell.
-
-    % the address of the second item on the stack is (TOS) + TEMP1[30:15]
-    % the address of the third stack cell         is (TOS) + TEMP1[15: 0]
-
-    lsl_imm(TEMP2, TEMP1, 2),  % Trim off the type tag 00 bits.
-    asr_imm(TEMP2, TEMP2, 17),  % TEMP2 := TEMP1 >> 15
-    eq_offset(Foo3),  % if the offset is zero don't add the address. it's empty list.
-    add(TEMP2, TEMP2, TOS),
-    label(Foo3),
+    ⟐(unpack_pair(TEMP1, TEMP2, TEMP3)),
     % TEMP2 contains the address of the second item on the stack
-
-    lsl_imm(TEMP3, TEMP1, 17),  % Get the offset of the third stack cell
-    asr_imm(TEMP3, TEMP3, 17),  % while preserving the sign.
-    eq_offset(Foo4),  % if the offset is zero don't add the address. it's empty list.
-    add(TEMP3, TEMP1, TOS),
-    label(Foo4),
     % TEMP3 = TOS +  TEMP1[15:0]  the address of the third stack cell
 
     % Build and write the new list cell.
+    [
     sub_imm(SP, SP, 4)
 
     ],⟐([
@@ -195,6 +168,22 @@ language.
      and_imm(Reg, Reg, 0x7fff),  % Mask off high bits.
      label(Label)].
 
+⟐(unpack_pair(From, HeadAddr, TailAddr)) -->
+    [
+    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, TOS),
+    label(Label0),
+    % HeadAddr contains the address of the second item on the stack
+    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, TOS),
+    label(Label1)
+    % TailAddr = TOS +  From[15:0]  the address of the third stack cell
+    ].
+
 
 do :-
     compile_program(Binary),
@@ -203,6 +192,7 @@ do :-
 
 compile_program(Binary) :-
     phrase(⟐(program), ASM),
+    writeln(ASM),
     phrase(linker(ASM), EnumeratedASM),
     phrase(asm(EnumeratedASM), Binary).