[PicForth] New words added

[J.C. Wren]

    I've added a couple words to the dictionary.  I've done some testing 
on them, but I don't know if they meet the "approved" methods or not.  I 
also added the bit definitions for the sspcon2 register in the 16F877.  
I don't know if all the parts have that or not.

    Included is the diff file against 0.31, generated with 'diff -u 
picforth.fs picforth.new'

    Feedback would be appreciated.

    --jc

--- picforth.fs 2004-06-25 00:22:16.295092007 -0400
+++ picforth.new        2004-06-25 00:07:13.067416538 -0400
@@ -742,6 +742,17 @@
   1 sspcon bit sspm1
   0 sspcon bit sspm0

+( sspcon2 bits )
+
+  7 sspcon2 bit gcen
+  6 sspcon2 bit ackstat
+  5 sspcon2 bit ackdt
+  4 sspcon2 bit acken
+  3 sspcon2 bit rcen
+  2 sspcon2 bit pen
+  1 sspcon2 bit rsen
+  0 sspcon2 bit sen
+
 ( sspstat bits )

   7 sspstat bit smp
@@ -1118,6 +1129,8 @@
 udata
 variable tmp1
 variable tmp2
+variable tmp3
+variable tmp4
 idata

 host
@@ -1128,6 +1141,10 @@
 : tmp1>w [ tmp1 ] literal ,w movf ;
 : w>tmp2 [ tmp2 ] literal movwf ;
 : tmp2>w [ tmp2 ] literal ,w movf ;
+: w>tmp3 [ tmp3 ] literal movwf ;
+: tmp3>w [ tmp3 ] literal ,w movf ;
+: w>tmp4 [ tmp4 ] literal movwf ;
+: tmp4>w [ tmp4 ] literal ,w movf ;

 \ Words to manipulate fsr register

@@ -1138,6 +1155,8 @@

 import: w>tmp1   import: tmp1>w
 import: w>tmp2   import: tmp2>w
+import: w>tmp3   import: tmp3>w
+import: w>tmp4   import: tmp4>w
 import: w>fsr    import: fsr>w

 host
@@ -1258,7 +1277,7 @@
 : c! meta> !
 ;

-: swap
+: swap ( w1 w2 -- w2 w1 )
     const? if
       kill-const const? if
         \ Swap two literals on the host (such as s" or l" results)
@@ -1274,24 +1293,53 @@
     pushw
 ;

-: over
+: nip ( w1 w2 -- w2 )
+  s" suspend-interrupts" evaluate
+  popw fsr ,f incf pushw
+  s" restore-interrupts" evaluate
+;
+
+: pick ( u -- w )
+  s" suspend-interrupts" evaluate
+  popw w>tmp1 fsr ,f addwf indf ,w movf w>tmp2 tmp1>w fsr ,f subwf 
tmp2>w pushw
+  s" restore-interrupts" evaluate
+;
+
+: rot ( w1 w2 w3 -- w2 w3 w1 )
+  s" suspend-interrupts" evaluate
+  popw w>tmp3 popw w>tmp2 popw w>tmp1 tmp2>w pushw tmp3>w pushw tmp1>w 
pushw
+  s" restore-interrupts" evaluate
+;
+
+: -rot ( w1 w2 w3 -- w3 w1 w2 )
+  s" suspend-interrupts" evaluate
+  popw w>tmp3 popw w>tmp2 popw w>tmp1 tmp3>w pushw tmp1>w pushw tmp2>w 
pushw
+  s" restore-interrupts" evaluate
+;
+
+: over ( w1 w2 -- w1 w2 w1 )
   s" suspend-interrupts" evaluate
   popw w>tmp1 loadw w>tmp2 tmp1>w pushw tmp2>w pushw
   s" restore-interrupts" evaluate
 ;

-: tuck
+: tuck ( w1 w2 -- w2 w1 w2 )
   s" suspend-interrupts" evaluate
   popw w>tmp1 loadw w>tmp2 tmp1>w storew tmp2>w pushw tmp1>w pushw
   s" restore-interrupts" evaluate
 ;

-: 2dup
+: 2dup ( w1 w2 -- w1 w2 w1 w2 )
   s" suspend-interrupts" evaluate
   popw w>tmp2 loadw w>tmp1 pushw tmp2>w pushw tmp1>w pushw tmp2>w pushw
   s" restore-interrupts" evaluate
 ;

+: 2swap ( w1 w2 w3 w4 -- w3 w4 w1 w2 )
+  s" suspend-interrupts" evaluate
+  popw w>tmp4 popw w>tmp3 popw w>tmp2 popw w>tmp1 tmp3>w pushw tmp4>w 
pushw tmp1>w pushw tmp2>w pushw
+  s" restore-interrupts" evaluate
+;

 : +!
     const? if                           \ Address is constant