Add D+ with test.

Author: Molorius

pkg/forth/primitive.go

@@ -2119,6 +2119,77 @@ func PrimitiveSetup(vm *VirtualMachine) error {
 				},
 			},
 		},
+		{
+			name: "D+", // ( xlow xhigh ylow yhigh -- zlow zhigh )
+			goFunc: func(vm *VirtualMachine, entry *DictionaryEntry) error {
+				yHigh, err := vm.Stack.PopNumber()
+				if err != nil {
+					return PopError(err, entry)
+				}
+				yLow, err := vm.Stack.PopNumber()
+				if err != nil {
+					return PopError(err, entry)
+				}
+				xHigh, err := vm.Stack.PopNumber()
+				if err != nil {
+					return PopError(err, entry)
+				}
+				xLow, err := vm.Stack.PopNumber()
+				if err != nil {
+					return PopError(err, entry)
+				}
+
+				y := (uint32(yHigh) << 16) | uint32(yLow)
+				x := (uint32(xHigh) << 16) | uint32(xLow)
+				z := x + y
+				zLow := uint16(z)
+				zHigh := uint16(z >> 16)
+				err = vm.Stack.Push(CellNumber{zLow})
+				if err != nil {
+					return PushError(err, entry)
+				}
+				err = vm.Stack.Push(CellNumber{zHigh})
+				if err != nil {
+					return PushError(err, entry)
+				}
+				return nil
+			},
+			ulpAsm: PrimitiveUlp{
+				"ld r0, r3, 3",   // xlow
+				"ld r1, r3, 1",   // ylow
+				"add r0, r0, r1", // add low
+				"st r0, r3, 3",   // store zlow
+				"ld r0, r3, 2",   // load xhigh
+				"ld r1, r3, 0",   // load yhigh
+				"jump __d_minus.0, ov",
+				"jump __d_minus.1",
+				"__d_minus.0:",
+				"add r0, r0, 1", // overload, add the carry bit
+				"__d_minus.1:",
+				"add r0, r0, r1", // add high
+				"add r3, r3, 2",  // decrement stack
+				"st r0, r3, 0",   // store zhigh
+				"jump __next_skip_r2",
+			},
+			ulpAsmSrt: PrimitiveUlpSrt{
+				Asm: []string{
+					"ld r0, r3, 3",   // xlow
+					"ld r1, r3, 1",   // ylow
+					"add r0, r0, r1", // add low
+					"st r0, r3, 3",   // store zlow
+					"ld r0, r3, 2",   // load xhigh
+					"ld r1, r3, 0",   // load yhigh
+					"jump __d_minus.0, ov",
+					"jump __d_minus.1",
+					"__d_minus.0:",
+					"add r0, r0, 1", // overload, add the carry bit
+					"__d_minus.1:",
+					"add r0, r0, r1", // subtract high
+					"add r3, r3, 2",  // decrement stack
+					"st r0, r3, 0",   // store zhigh
+				},
+			},
+		},
 	}
 	for _, p := range prims {
 		err := primitiveAdd(vm, p.name, p.goFunc, p.ulpAsm, p.ulpAsmSrt, p.flag)

pkg/forth/suite_test.go

@@ -1362,7 +1362,7 @@ func TestSuite(t *testing.T) {
 				T{  HI-2INT  lo-2INT D- -> max-2INT }T
 				// T{  LO-2INT  hi-2INT D- -> min-2INT 1. D+ }T
 				T{ MIN-2INT min-2INT D- -> 0. }T
-				// T{ MIN-2INT  lo-2INT D- -> lo-2INT }T \ TODO fixme
+				T{ MIN-2INT  lo-2INT D- -> lo-2INT }T \ TODO fixme
 			`,
 		},
 		{
@@ -1375,7 +1375,37 @@ func TestSuite(t *testing.T) {
 				T{ min-2int SWAP 1+ SWAP DNEGATE -> max-2int }T
 			`,
 		},
-		// D+
+		{
+			name: "D+",
+			code: `
+				T{  0.  5. D+ ->  5. }T                         \ small integers
+				T{ -5.  0. D+ -> -5. }T
+				T{  1.  2. D+ ->  3. }T
+				T{  1. -2. D+ -> -1. }T
+				T{ -1.  2. D+ ->  1. }T
+				T{ -1. -2. D+ -> -3. }T
+				T{ -1.  1. D+ ->  0. }T
+				T{  0  0  0  5 D+ ->  0  5 }T                  \ mid range integers
+				T{ -1  5  0  0 D+ -> -1  5 }T
+				T{  0  0  0 -5 D+ ->  0 -5 }T
+				T{  0 -5 -1  0 D+ -> -1 -5 }T
+				T{  0  1  0  2 D+ ->  0  3 }T
+				T{ -1  1  0 -2 D+ -> -1 -1 }T
+				T{  0 -1  0  2 D+ ->  0  1 }T
+				T{  0 -1 -1 -2 D+ -> -1 -3 }T
+				T{ -1 -1  0  1 D+ -> -1  0 }T
+
+				T{ MIN-INT 0 2DUP D+ -> 0 1 }T
+				T{ MIN-INT S>D MIN-INT 0 D+ -> 0 0 }T
+
+				T{  HI-2INT       1. D+ -> 0 HI-INT 1+ }T    \ large double integers
+				T{  HI-2INT     2DUP D+ -> 1S 1- MAX-INT }T
+				T{ MAX-2INT MIN-2INT D+ -> -1. }T
+				T{ MAX-2INT  LO-2INT D+ -> HI-2INT }T
+				T{  LO-2INT     2DUP D+ -> MIN-2INT }T
+				T{  HI-2INT MIN-2INT D+ 1. D+ -> LO-2INT }T
+			`,
+		},
 		// D2/
 		// D2*
 		{

pkg/forth/test/suite_test.f

@@ -94,6 +94,8 @@
 0x7FFF CONSTANT MAX-INT
 0      CONSTANT MIN-UINT
 0x8000 CONSTANT MIN-INT
+MAX-INT 2/ CONSTANT HI-INT
+MIN-INT 2/ CONSTANT LO-INT
 0x7FFF CONSTANT MID-UINT
 0x8000 CONSTANT MID-UINT+1
 0      CONSTANT 0S
@@ -103,8 +105,8 @@
 0x7FFFFFFF. 2CONSTANT MAX-2INT
 0.          2CONSTANT MIN-2UINT
 0x80000000. 2CONSTANT MIN-2INT
-0x1FFFFFFF. 2CONSTANT HI-2INT
-0xA0000000. 2CONSTANT LO-2INT
+MAX-2INT 2/ 2CONSTANT HI-2INT
+MIN-2INT 2/ 2CONSTANT LO-2INT
 
 HEX \ the test suite runs in hex mode