aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/common/lib/forth2012/double
diff options
context:
space:
mode:
Diffstat (limited to 'amforth-6.5/common/lib/forth2012/double')
-rw-r--r--amforth-6.5/common/lib/forth2012/double/2-fetch.frt7
-rw-r--r--amforth-6.5/common/lib/forth2012/double/2-store.frt7
-rw-r--r--amforth-6.5/common/lib/forth2012/double/2constant.frt6
-rw-r--r--amforth-6.5/common/lib/forth2012/double/2nip.frt4
-rw-r--r--amforth-6.5/common/lib/forth2012/double/2rot.frt3
-rw-r--r--amforth-6.5/common/lib/forth2012/double/2tuck.frt3
-rw-r--r--amforth-6.5/common/lib/forth2012/double/2variable.frt4
-rw-r--r--amforth-6.5/common/lib/forth2012/double/d-equal.frt2
-rw-r--r--amforth-6.5/common/lib/forth2012/double/d-greater-zero.frt8
-rw-r--r--amforth-6.5/common/lib/forth2012/double/d-greater.frt3
-rw-r--r--amforth-6.5/common/lib/forth2012/double/d-less-zero.frt2
-rw-r--r--amforth-6.5/common/lib/forth2012/double/d-less.frt5
-rw-r--r--amforth-6.5/common/lib/forth2012/double/d-max.frt3
-rw-r--r--amforth-6.5/common/lib/forth2012/double/d-min.frt2
-rw-r--r--amforth-6.5/common/lib/forth2012/double/d-plusstore.frt4
-rw-r--r--amforth-6.5/common/lib/forth2012/double/d-zero-equal.frt3
-rw-r--r--amforth-6.5/common/lib/forth2012/double/m-plus.frt2
-rw-r--r--amforth-6.5/common/lib/forth2012/double/m-star-slash.frt7
18 files changed, 75 insertions, 0 deletions
diff --git a/amforth-6.5/common/lib/forth2012/double/2-fetch.frt b/amforth-6.5/common/lib/forth2012/double/2-fetch.frt
new file mode 100644
index 0000000..9b3a76a
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/2-fetch.frt
@@ -0,0 +1,7 @@
+\ 2@ ( addr -- n1 n2 )
+: 2@
+ dup ( -- addr addr )
+ cell+ ( -- addr addr+2 )
+ @ ( -- addr n2 )
+ swap ( -- n2 addr )
+ @ ; ( -- n2 n1 )
diff --git a/amforth-6.5/common/lib/forth2012/double/2-store.frt b/amforth-6.5/common/lib/forth2012/double/2-store.frt
new file mode 100644
index 0000000..93d2402
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/2-store.frt
@@ -0,0 +1,7 @@
+\ 2! ( n1 n2 addr -- )
+: 2!
+ swap ( -- n1 addr n2 )
+ over ( -- n1 addr n2 addr )
+ ! ( -- n1 addr )
+ cell+ ( -- n1 addr+2 )
+ ! ;
diff --git a/amforth-6.5/common/lib/forth2012/double/2constant.frt b/amforth-6.5/common/lib/forth2012/double/2constant.frt
new file mode 100644
index 0000000..4f012d3
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/2constant.frt
@@ -0,0 +1,6 @@
+
+: 2constant
+ create , ,
+ does>
+ dup 1+ @i swap @i
+;
diff --git a/amforth-6.5/common/lib/forth2012/double/2nip.frt b/amforth-6.5/common/lib/forth2012/double/2nip.frt
new file mode 100644
index 0000000..04c5599
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/2nip.frt
@@ -0,0 +1,4 @@
+\ 2nip ( w1 w2 w3 w4 -- w3 w4 ) gforth two_nip
+: 2nip
+ 2swap 2drop ;
+
diff --git a/amforth-6.5/common/lib/forth2012/double/2rot.frt b/amforth-6.5/common/lib/forth2012/double/2rot.frt
new file mode 100644
index 0000000..4befd64
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/2rot.frt
@@ -0,0 +1,3 @@
+\ 2rot ( w1 w2 w3 w4 w5 w6 -- w3 w4 w5 w6 w1 w2 ) double-ext two_rote
+: 2rot
+ >r >r 2swap r> r> 2swap ;
diff --git a/amforth-6.5/common/lib/forth2012/double/2tuck.frt b/amforth-6.5/common/lib/forth2012/double/2tuck.frt
new file mode 100644
index 0000000..9ad9781
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/2tuck.frt
@@ -0,0 +1,3 @@
+\ 2tuck ( w1 w2 w3 w4 -- w3 w4 w1 w2 w3 w4 ) gforth two_tuck
+: 2tuck
+ 2swap 2over ;
diff --git a/amforth-6.5/common/lib/forth2012/double/2variable.frt b/amforth-6.5/common/lib/forth2012/double/2variable.frt
new file mode 100644
index 0000000..f6b63fb
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/2variable.frt
@@ -0,0 +1,4 @@
+
+: 2variable
+ here 2 cells allot constant
+;
diff --git a/amforth-6.5/common/lib/forth2012/double/d-equal.frt b/amforth-6.5/common/lib/forth2012/double/d-equal.frt
new file mode 100644
index 0000000..db5a9c6
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/d-equal.frt
@@ -0,0 +1,2 @@
+ ( d1 d2 -- f )
+: d= d- or 0= ;
diff --git a/amforth-6.5/common/lib/forth2012/double/d-greater-zero.frt b/amforth-6.5/common/lib/forth2012/double/d-greater-zero.frt
new file mode 100644
index 0000000..3628320
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/d-greater-zero.frt
@@ -0,0 +1,8 @@
+
+\ #require d-less-zero.frt
+
+: d0> ( d -- f)
+ 2dup or >r \ not equal zero
+ d0< 0= r> and \ and not less zero
+ 0= 0= \ normalize to 0/-1 flag
+;
diff --git a/amforth-6.5/common/lib/forth2012/double/d-greater.frt b/amforth-6.5/common/lib/forth2012/double/d-greater.frt
new file mode 100644
index 0000000..133cdcd
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/d-greater.frt
@@ -0,0 +1,3 @@
+
+( d1 d2 -- f )
+: d> d- d0> ;
diff --git a/amforth-6.5/common/lib/forth2012/double/d-less-zero.frt b/amforth-6.5/common/lib/forth2012/double/d-less-zero.frt
new file mode 100644
index 0000000..973b9da
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/d-less-zero.frt
@@ -0,0 +1,2 @@
+
+: d0< nip 0< ;
diff --git a/amforth-6.5/common/lib/forth2012/double/d-less.frt b/amforth-6.5/common/lib/forth2012/double/d-less.frt
new file mode 100644
index 0000000..b85cbb8
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/d-less.frt
@@ -0,0 +1,5 @@
+
+\ #require d-less-zero.frt
+
+( d1 d2 -- f )
+: d< d- d0< ;
diff --git a/amforth-6.5/common/lib/forth2012/double/d-max.frt b/amforth-6.5/common/lib/forth2012/double/d-max.frt
new file mode 100644
index 0000000..fcf979a
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/d-max.frt
@@ -0,0 +1,3 @@
+
+: dmax ( d1 d2 -- d ) \ double d-max
+ 2over 2over d< if 2swap then 2drop ;
diff --git a/amforth-6.5/common/lib/forth2012/double/d-min.frt b/amforth-6.5/common/lib/forth2012/double/d-min.frt
new file mode 100644
index 0000000..beca796
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/d-min.frt
@@ -0,0 +1,2 @@
+: dmin ( d1 d2 -- d ) \ double d-min
+ 2over 2over d> if 2swap then 2drop ;
diff --git a/amforth-6.5/common/lib/forth2012/double/d-plusstore.frt b/amforth-6.5/common/lib/forth2012/double/d-plusstore.frt
new file mode 100644
index 0000000..c7405b5
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/d-plusstore.frt
@@ -0,0 +1,4 @@
+
+: d+! ( d addr -- ) \ same as +! but for double cell numbers
+ dup >r 2@ d+ r> 2!
+;
diff --git a/amforth-6.5/common/lib/forth2012/double/d-zero-equal.frt b/amforth-6.5/common/lib/forth2012/double/d-zero-equal.frt
new file mode 100644
index 0000000..a853671
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/d-zero-equal.frt
@@ -0,0 +1,3 @@
+
+( d -- f )
+: d0= or 0= ;
diff --git a/amforth-6.5/common/lib/forth2012/double/m-plus.frt b/amforth-6.5/common/lib/forth2012/double/m-plus.frt
new file mode 100644
index 0000000..f716566
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/m-plus.frt
@@ -0,0 +1,2 @@
+
+: m+ s>d d+ ;
diff --git a/amforth-6.5/common/lib/forth2012/double/m-star-slash.frt b/amforth-6.5/common/lib/forth2012/double/m-star-slash.frt
new file mode 100644
index 0000000..94959d4
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/double/m-star-slash.frt
@@ -0,0 +1,7 @@
+
+: m*/ ( d1 n2 u3 -- dquot ) \ double m-star-slash
+ >r s>d >r abs rot rot
+ s>d r> xor r> swap >r >r dabs rot tuck um* 2swap um*
+ swap >r 0 d+ r> rot rot r@ um/mod rot rot r> um/mod
+ nip swap r> if dnegate then
+;