Jump to content
TheBF

Camel99 Forth Information goes here

Recommended Posts

When you turn over stones you always find a few bugs. :)

 

Your re-working of the TI-Forth document is still to be commended as it exists in professional form for people to review forever now.

The original is more like shards of the dead sea scrolls. 

 

It never ceases to amaze me how difficult software is as a human occupation. 

 

I have been in correspondence with ED over the last couple of days. He got involved because of concern that perhaps his code was not "endian" proofed.

In making Camel99 I had followed the TI MSP430 CPU version as it was the most similar to 9900.

In that kernel Brad has M+ as a code word because MSP430 has an ADDC (add with carry) instruction. This meant M+ was only three instructions.

I naively tried to follow that template.

 

Yesterday I realized that D+ is a better primitive and later, after I did it that way, Ed wrote and confirmed to me that he thought D+ with S>D as code word would be a better fit. 

So that was a good confirmation.

 

I looked at your D+ which I cannot do with TOS in a register but based on it I came up with this which is much smaller than I had before.

 
CODE D+   ( lo hi lo' hi' -- d)
     *SP+    R0  MOV, 
     *SP+    TOS ADD, 
      R0     *SP ADD,  
      OC IF, 
         TOS INC,  
      ENDIF,
      NEXT,  
ENDCODE
 

All in all another validation of the "more eyes are better" approach when it comes to reviewing text.

 

In the complexity breeds complexity file:

 

Ed wrote this morning to tell me that my github change fixed the source code files but now the pdf files are corrupted. 

LOL.  Amazing...

 

  • Like 3

Share this post


Link to post
Share on other sites

Kernel 2.68

 

Fixes error in M+.  

Puts D+ in the kernel

Changes S>D to a code word and uses it to make M+.

 

: M+   ( d n -- d)  S>D M+ ;

 

This kernel has been running here for a week and seems stable in all my activities.

 

Please  put the CAMEL99  program file, in the attached ZIP file, into your DSK1.  -and-  replace DSK1.SYSTEM with this new version as well.

 

DSK1.SYSTEM has been simplified a bit and INCLUDE not longer tampers with the BASE variable. (stupid idea by me) 

In DSK1.SYSTEM there is a small definition for the word ALIAS.  It allows you create small synonyms for a CODE word  that are minimal in size.

ALIAS is not a standard word and my version was not like others.  I have changed mine to be more like other Forth systems that I become aware of like this: 

 

' 2+  ALIAS CELL+   

 

I am confident enough with this version to call the program CAMEL99 so use that name to start this version.

 

The test program that uncovered the M+ error is in the spoiler. 

Load it and type 20 PI  ( or the number of digits you want)  

100 digits takes 7.6 seconds.  (1000 takes longer than the simple elapsed timer can do)

 

Spoiler
\ PI.FTH from DxForth 
\
\ Revised 2015-02-09  es
\
\ Compute Pi to an arbitrary precision. Uses Machin's
\ formula:  pi/4 = 4 arctan(1/5) - arctan(1/239)
\
\ Compile with 16-bit DX-Forth: FORTH - INCLUDE PI.F BYE
\ Compile with CAMEL99 Forth: INCLUDE DSK*.PI  ( where * is your drive no.)
\
\ This 16-bit implementation allows up to 45,808 digits
\ to be computed before arithmetic overflow occurs.
\
\ The code can be used on 32-bit targets with appropriate
\ changes:
\
\   16-bit             32-bit
\
\   10000 Multiply     100000000 Multiply
\   <# # # # # #>      <# # # # # # # # # #>
\   4 +loop            8 +loop
\   525 um/mod         1050 um/mod
\                      remove 'digits > 45808' warning
\
\ Acknowledgements:
\
\   Roy Williams, Feb 1994
\   J. W. Stumpel, May 1991
\   E. Ford, Aug 2009
\   R. Bishop, Aug 1978
\
\ This code is PUBLIC DOMAIN. Use at your own risk.

\ Modified for Camel99 Forth  Mar 2021 Fox
NEEDS D.	  FROM DSK1.DOUBLE
NEEDS DUMP  FROM DSK1.TOOLS
NEEDS VALUE FROM DSK1.VALUES
NEEDS .R    FROM DSK1.UDOTR
NEEDS ELAPSE FROM DSK1.ELAPSE

DECIMAL
0 VALUE POWER  ( adr)
0 VALUE TERM   ( adr)
0 VALUE RESULT ( adr)
0 VALUE SIZE   ( n)

VARIABLE CARRY

: ADD ( -- )
  0 CARRY !
  RESULT
  0 SIZE 1- DO
    I CELLS OVER + ( res) DUP @ 0
    I CELLS TERM + @ 0  D+  CARRY @ M+
    ( hi) CARRY !  ( lo) SWAP ( res) !
  -1 +LOOP  DROP ;

: SUBTRACT ( -- )
  0 CARRY !
  RESULT
  0 SIZE 1- DO
    I CELLS OVER + ( RES) DUP @ 0
    I CELLS TERM + @ 0  D-  CARRY @ M+
    ( HI) CARRY !  ( LO) SWAP ( RES) !
  -1 +LOOP  DROP ;

0 VALUE FACTOR

\ scan forward for cell containing non-zero
: +INDEX ( ADR -- ADR INDEX )
    -1
    BEGIN 1+ DUP SIZE -
    WHILE
       2DUP CELLS + @
    UNTIL
    THEN ;

: (DIVIDE)
  ?DO
     I CELLS OVER + ( res)
     DUP @  CARRY @  FACTOR  UM/MOD
    ( quot) ROT ( res) !  ( rem) CARRY !
  LOOP ;

: DIVIDE ( ADR FACTOR -- )
  TO FACTOR   0 CARRY !  +INDEX
  ( adr index )  SIZE SWAP
  (DIVIDE)
  DROP ;

\ scan backward for cell containing non-zero
: -INDEX ( adr -- adr index )
    SIZE
    BEGIN 1- DUP
    WHILE
       2DUP CELLS + @
    UNTIL
    THEN ;

: MULTIPLY ( adr factor -- )
  TO FACTOR   0 CARRY !  -INDEX
  ( adr index )  0 SWAP
  DO
    I CELLS OVER + ( res)
    DUP @  FACTOR  UM*  CARRY @ M+
    ( hi) CARRY !  ( lo) SWAP ( res) !
  -1 +LOOP
  DROP ;

: COPY ( -- ) POWER TERM SIZE CELLS CMOVE ; \ changed CMOVE to MOVE

: ZERO? ( result -- f )  +INDEX NIP SIZE = ;

0 VALUE PASS
VARIABLE EXP
VARIABLE SIGN

: DIVISOR ( -- N )
  PASS 1 = IF  5  ELSE  239  THEN ;

: ERASE  0 FILL ;

: INITIALIZE ( -- )
  POWER SIZE CELLS ERASE
  TERM  SIZE CELLS ERASE
  PASS 1 = IF  RESULT SIZE CELLS ERASE  THEN
  16  PASS DUP * / POWER !
  POWER  DIVISOR  DIVIDE
  1 EXP !  PASS 1- SIGN ! ;

0 VALUE NDIGIT

: CalcPi ( -- )
  NDIGIT 45800 U> IF
    ." Warning: digits > 45808 will be in error " CR
  THEN

  2 1+ 1
  DO
    I TO PASS
    INITIALIZE
    BEGIN
      COPY
      TERM  EXP @ DIVIDE
      SIGN @  DUP IF  SUBTRACT  ELSE  ADD  THEN
      0= SIGN !  2 EXP +!
      POWER  DIVISOR DUP *  DIVIDE
      POWER ZERO?
    UNTIL
  LOOP ;

\ Camel99 has OUT but I don't use in the Video driver
\ : CR  CR  OUT OFF ;
\ : #   #   OUT 1+! ;

DECIMAL
: (PRINT)
   ?DO
    0 OVER !
    DUP 10000 MULTIPLY
    DUP @  0 <# # # # # #> TYPE SPACE
    VCOL @ 3 + C/L @ > IF CR THEN
  4  +LOOP ;

: PRINT ( -- )
  CR
  RESULT  DUP @ 0 .R  [CHAR] . EMIT SPACE
  NDIGIT 0 (PRINT)
  DROP  CR ;

\ : GetNumber ( -- n )
\  CR ." How many digits do you want? "
\  PAD DUP 20 ACCEPT NUMBER? ABORT" Invalid" CR ;

: PI ( n -- )
( GetNumber ) DUP TO NDIGIT

  \ array size = ceil(ndigit / log10(2^16))
  109 UM* 525 UM/MOD SWAP ( rem) IF  1+  THEN
  2+  TO SIZE    ( extra for accurate last digits)

  50 ALLOT  ( expand the HOLD buffer space)

  HERE TO POWER   SIZE CELLS ALLOT
  HERE TO TERM    SIZE CELLS ALLOT
  HERE TO RESULT  SIZE CELLS ALLOT

  TICKER OFF
  CalcPi
  .ELAPSED
  PRINT
;
CR .( Usage:  20 PI )

 

 

 

 

 

 

 

CAMEL268.ZIP

  • Like 3

Share this post


Link to post
Share on other sites

Is there a better way?

 

I have been reviewing all my demo programs and saw that my coincidence code was written in Forth and it would benefit from some coding.

This is the common code code in Forth that is used by COINC and COINCXY.

: (COINC) ( x1 y1 x2 y2 tol -- ? )
         >R
          ROT - ABS [email protected] <
         -ROT - ABS R> <
          AND ; 

 

Came up with this which is kind of literal translation and it works but it seems like a lot of code.

Are there any clever code tricks that I don't know about that would speed this up?

Perhaps we are limited because Forth needs the flag on the top of stack versus using the status register?

 

The CODE version is only about 2X faster than the Forth version in this case.

That's why I am thinking that it could be sub-optimal.

CODE (COINC) ( x1 y1 x2 y2 tol -- ? )
          TOS  R0 MOV,
          *SP+ R1 MOV,
          *SP+ R2 MOV,

          *SP+ R1 SUB,
          R1 ABS,
          R1 R0 CMP,
          LO IF,  TOS SETO,
          ELSE,   TOS CLR,
          ENDIF,

         *SP+ R2 SUB,
          R2 ABS,
          R2 R0 CMP,
          LO IF, R3 CLR,  \ invert logic for SZC later
          ELSE,  R3 SETO,
          ENDIF,

          R3 TOS SZC,
          NEXT,
ENDCODE  

 

For reference here is how this fits into the final code.

: COINCXY   ( dx dy sp# tol -- ? ) SWAP POSITION ROT (COINC) ;

: COINC ( spr#1 spr#2 tol -- ?)
        COINCALL
        IF >R
          POSITION ROT POSITION ( -- x1 y1 x2  y2 )
          R> (COINC)
          EXIT          \ get out
        THEN            \ if coincall=true then do this
        2DROP DROP      \ drop parameters
        FALSE           \ return false flag
 ;

 

  • Like 3

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...

  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...