コミット: 4df80e85a95a025aa7dd1dcc66316b3ca0fd60dc - xhilr_calendar (git)

Functions for working with the idealized calendar of Planet Xhilr

コミットメタ情報

• リビジョン: 4df80e85a95a025aa7dd1dcc66316b3ca0fd60dc (tree)
• 日時: 2017-06-13 18:05:45
• 作者: Joel Matthew Rees <joel.rees@gmai...>
• コミッター: Joel Matthew Rees

ログメッセージ

full double division in Forth-level code

変更サマリ

• modified: econmonths.fs

差分

--- a/econmonths.fs
+++ b/econmonths.fs
@@ -120,19 +120,6 @@
 : DMIN ( d1 d2 --- d : Leave smaller of top two. )
   4DUP D< IF 2DROP ELSE 2SWAP 2DROP THEN ;
 
-( 2/ and d2/ requires words which have various names -- u/, etc., )
-( and are very slow. )
-( Just best to do in assembler, along with UD* and UQD/MOD . )
-( : 2* DUP + ; ( u1 --- u2 : Double the top cell. Not fastest. )
-
-( : D2* 2DUP D+ ; ( ud1 --- ud2 : Double the top double cell. Not fastest. )
-
-( Do it in assembler instead! )
-( : 2/ 0 2 UM/MOD SWAP DROP ; ( u1 --- u2 : Halve the top cell. SLOW! )
-
-( Do it in assembler instead! )
-( : D2/ 2 M/MOD ROT DROP ; ( uD1 --- uD2 : Halve the top cell. SLOW! )
-
 ( : R@ R ; ( Modern name for copy top of return stack. )
 
 ( Showing the above in infix won't help. )
@@ -143,10 +130,12 @@
 ( -- even if all you have is the bit math. )
 
 
-( Already there as M/MOD in some Forths: )
+( JM/MOD is already there as M/MOD in some Forths: )
 ( : JM/MOD M/MOD ; ( uddividend udivisor -- uremainder udquotient ) 
 : JM/MOD ( uddividend udivisor -- uremainder udquotient )
   >R 0 R> DUP >R UM/MOD R> SWAP >R UM/MOD R> ; 
+( Tick ' has various semantics, even in different fig Forths. )
+( This definition is safe, anyway. )
 
 SP@ SP@ - ABS CONSTANT CELLWIDTH
 ( Infix won't help here, either, but I can try to explain: )
@@ -164,6 +153,25 @@ SP@ SP@ - ABS CONSTANT CELLWIDTH
   CELLWIDTH + ! ( MS-CELL )
 ;
 
+( Left shifts can be done with addition. )
+: SUM2* DUP + ; ( u1 --- u2 : Double the top cell. Not fastest, not too slow. )
+: SUMD2* 2DUP D+ ; ( ud1 --- ud2 : Double the top double cell. Not fastest. )
+: SLOWQ2*  ( uq1 --- uq2 : Double the top double cell. Not fastest. )
+  SUMD2* >R OVER 0< IF 
+    1 OR ( carry )
+  THEN
+  >R 
+  SUMD2*
+  R> R> ;
+
+: MY-BIT-COUNTER ( --- u ) ( Let's figure out how wide a CELL is. )
+  0. 1. BEGIN
+    SUMD2* 2SWAP 1. D+ 2SWAP SP@ @
+  UNTIL 2DROP DROP ;
+
+MY-BIT-COUNTER CONSTANT CELLBITS 
+CELLBITS CELLWIDTH /MOD CONSTANT BYTEBITS CONSTANT LEFTOVERBITS
+
 ( Semi-simulate local variables with the ability to fetch and store relative to top of stack. )
 
 ( Infix will be confusing here, too. )
@@ -311,19 +319,75 @@ SP@ SP@ - ABS CONSTANT CELLWIDTH
   3 LC! 3 LC! 3 LC! 3 LC! 
 ;
 
-( Scaling, to keep the steps time-bounded, is going to leave me at the binary long division )
-( unless I use tables. Tables will not fit in a 16-bit address space. )
-( AL AML AMH AH BL BH --- QL QML QMH QH : unsigned 4-cell by unsigned double yielding 4-cell unsigned )
-( : UQD/MOD ( uqdividend uddivisor --- udremainder uhqquotient )
-(  DUP 0= IF )
-(    DROP UQS/MOD ( Get divisor high word 0 case out of the way. )
-(  ELSE )
-(    2>R ( Divisor high byte handy. )
-(    DUP 0 R> DUP >R JM/MOD ( Trial division for guess. )
-(    ROT DROP 2R> 2DUP 2>R UMD* )
-( )
-(  THEN )
-( ; )
+
+( 2/ and d2/ require words which have various names -- u/, etc., )
+( and are very slow. )
+( Just best to do in assembler, along with UD* and UQD/MOD . )
+
+( Do it in assembler instead! Hundreds of times as slow!!!! )
+: DIV2/ ( u1 --- u2 : Halve the top cell. REALLY SLOW! )
+  S>D 2 UM/MOD SWAP DROP ;
+
+( Do it in assembler instead! Hundreds of times as slow!!!! )
+: DIVD2/ ( ud1 --- ud2 : Halve the top double cell. REALLY SLOW! )
+  2 UM/MOD ROT DROP ;
+
+( Scaling, to keep the steps time-bounded, )
+( is going to leave me at the binary long division )
+( unless I use tables. )
+( Tables will not fit in a 16-bit address space. )
+( And scaling requires shifts, )
+( which are painfully slow if not defined low level. )
+( Some dividends will overflow quotient, not valid for such cases. )
+( Intended to be used for known products of two doubles. 
+( AL AML AMH AH BL BH --- RL RH QL QH : unsigned quad by unsigned double yielding unsigned double )
+: MOLASSES-UMD/MOD ( uqdividend uddivisor --- udremainder udquotient )
+  DUP 0= IF
+    DROP UQS/MOD 2DROP 0 ROT ROT ( Get divisor high word 0 easy case done quickly. )
+  ELSE
+    2ROT 2ROT ( Get the divisor out of the way, but accessible with pick. )
+    CELLBITS SUM2* 1+ >R   ( Count )
+    0 >R   ( Force flag )
+    BEGIN 
+      2DUP    ( high double of dividend )
+      6 DLC@ D< 0=   ( Greater or equal? )
+      R> OR    ( Force it? )
+      IF
+        D- 1 ( Mark the subtraction. )
+      ELSE
+        DROP 0 ( Mark no subtraction. )
+      THEN
+      SWAP >R SWAP >R   ( Save top half of remainder and bury the subtraction flag. )
+      OVER >R   ( Remember the carry from bottom to top half -- AML. )
+      >R SUMD2*   ( Save subtraction flag and shift the bottom half: AL AML. )
+      SWAP R> OR SWAP   ( Record the subtraction in emptied bit of remainder. )
+      R> DUP 0< IF 1 ELSE 0 THEN ( Convert AML to bit to shift in to top half. )
+      R> R>   ( BL BH AL AML CARRY AMH AH )
+      R> 1 - DUP >R    ( Count down. )
+      WHILE   ( BL BH AL AML CARRY AMH AH )
+        DUP 0< >R   ( Remember the high bit of the remainder, to force subtract. )
+        SUMD2* >R OR R>   ( Shift the remainder, with the bit from the low half. )
+    REPEAT   ( BL BH AL AML AMH AH )
+    R> DROP   ( the count )
+    ( BL BH QL QH RL RH )
+    2>R 2>R 2DROP 2R> 2R>   ( QL QH RL RH )
+    2SWAP
+  THEN
+; 
+
+( If your 16-bit Forth has UD/MOD, uncomment this and comment out the fake! *********** )
+( : JUD/MOD UD/MOD ; ( uqdividend uddivisor -- udremainder udquotient : If it exists. )
+( If UD/MOD does not exist and we are working on 32 or 64 bit, fake it. )
+( But make it safe! )
+: JUD/MOD ( uqdividend uddivisor -- udremainder udquotien : fake double division )
+  
+  CELLWIDTH 4 < 0= IF 
+    DROP >R 2DROP R> JM/MOD  
+  ELSE ( Things get hairy! )
+    
+  THEN ; 
+( In 32-bit or more, get rid of unneeded stuff and use single division. )
+
 
 ( Make things easier to read. )
 ( Infix will be confusing here, too. )