Fleet Forth design considerations

[barrym95838]

Add a vote for the "comment style" from me as well.

[JimBoyd]

JimBoyd wrote:

In Fleet Forth, I treat some of the CONSTANTs more like VALUEs. I was wondering if it would be worth the overhead in memory to implement VALUEs and redefine IS and (IS) to only work on VALUEs and DEFERed words.

Code: Select all

: IS  ( -- )
   ' DUP @
   DUP [ ' #BUF @ ] LITERAL <>
   SWAP [ ' TYPE @ ] LITERAL <> AND
   ABORT" CAN'T SET"
   STATE @
   IF  COMPILE (IS) , EXIT  THEN
   >BODY ! ; IMMEDIATE

#BUF is a VALUE and TYPE is a DEFERred word.

I didn't mention it before, but this version of IS parses. Although IS checks to see if a word is deferred or a value, (IS) doesn't care. Since Fleet Forth is ram based, not all constants that need to be changeable ( semi constants? )are values. I guess you could say that Fleet Forth has three types of constant-like words:
The hard constants are words such as 2 , 3 , C/L , and B/BUF that should be immutable. They are defined with CONSTANT .
The values are words such as COLS , #BUF , and LIMIT that one can freely change and are defined with VALUE .
The 'soft' constants are words such as MRU and LRU that need changed by one of the Forth words ( in this case CONFIGURE ), but should never be modified any other way. These words are still CONSTANTs in Fleet Forth.
If Fleet Forth were in ROM, I would need a new constant-like word, maybe SEMICONSTANT or SOFTCONSTANT , but they're a bit long.

[JimBoyd]

I've just streamlined DJIFFIES , the word that takes a positive double number and waits that many jiffies ( 1/60th of a second on the Commodore 64 ) . It is also used by JIFFIES , the word that takes an unsigned single number and waits that many jiffies.
DJIFFIES works by keeping the number of jiffies to delay on the stack as well as the latest jiffy clock value. Each time through the loop, it subtracts the difference from the amount of time to wait. The idea came from DOWN-COUNTER on page 130 ( 140 of the PDF ) in the book Real Time Forth by Tim Hendtlass.
When I was testing my multitasker, I noticed that the loop in DJIFFIES runs several times per jiffy. With three background tasks, two using DJIFFIES ( actually JIFFIES ) for a delay and one counting how many times it runs, the entire round robin runs several times a jiffy. I realized that when the difference between the current jiffy clock value and the previous one is subtracted from the amount of time to delay, either 0 or -1 is added to the remaining time. I only needed to use the lower cell of the jiffy clock value. Here is the code:

Code: Select all

SCR# 41 
// DJIFFIES
HEX
// TAKES POSITIVE DOUBLE NUMBER
// AND DELAYS THAT MANY JIFFIES
: DJIFFIES  ( D+ -- )
   JIFFY@ DROP
   BEGIN
      PAUSE
      JIFFY@ DROP  DUP>R -
// COMPENSATE FOR RESET AT 24 HOURS
      0 MIN
      S>D D+  R> OVER 0<
   UNTIL
   DROP 2DROP ;

SCR# 42 
// JIFFIES
HEX
: JIFFIES  ( U -- )
   0 DJIFFIES ;

JIFFIES takes an unsigned number and has a maximum delay of:
18 minutes 12 seconds and 15 jiffies.
DJIFFIES takes a positive double number and has a maximum delay of:
414 days 6 hours 3 minutes 14 seconds and 7 jiffies or
2,147,483,647 jiffies.

[JimBoyd]

Here is a print dump from an interactive session where I performed a rough test on JIFFIES ( and therefore DJIFFIES .) The word TEST 'borrows' PAUSE to increment a counter once each time through the loop and resets it at the end of the test. The BASE is decimal.

Code: Select all

 OK
VARIABLE COUNTER  OK
CODE UPCOUNT  OK
COUNTER INC,  OK
0= IF,  COUNTER 1+ INC,  THEN,  OK
NEXT JMP, END-CODE  OK
SEE UPCOUNT 
UPCOUNT
 22473 22457    INC ' COUNTER >BODY
 22476 22481    BNE
 22478 22458    INC ' COUNTER >BODY 1 +
 22481  2111    JMP NEXT
 OK
: TEST 
COUNTER OFF 
['] UPCOUNT IS PAUSE 
100 JIFFIES 
SINGLE ;  OK
TEST COUNTER ? 1604  OK
CONSOLE 

So the delay loop, including the code to increment COUNTER runs about 16 times per jiffy or roughly 960 times per second.

[JimBoyd]

While developing Fleet Forth, I've been using it as a testbed for Forth ideas. I'm not even sure if testbed is the right word as I have no professional programming experience.
In Fleet Forth, TYPE is a deferred word that is normally set to (TYPE). There is also the printer version, (PTYPE) , and the logger version ( to send output to both the printer and the screen ) , (LTYPE). There is a separate word, DTYPE , which is not deferred and is used to send commands to the disk drive. The only real difference is that the other TYPE words update variables for output formatting and DTYPE does not.
(TYPE) , (PTYPE) , and (LTYPE) all call PAUSE after 'typing' the string. The last two also have to clear the communications channel to the printer when they are done and before pausing. The easiest thing to do was have (TYPE) branch to CLRCHN .This requires a renaming of (TYPE) to <TYPE> and factoring out PAUSE . If I'm branching into another code word, I can't have a transition to high level to call PAUSE . Even if <TYPE> didn't branch to CLRCHN to clear the communications channel, it would still need to be a separate factor for (PTYPE) since (PTYPE) must clear the channel before pausing.

Code: Select all

: (TYPE)  ( ADR CNT -- )
   <TYPE> PAUSE ;

(PTYPE) would be defined as:

Code: Select all

: (PTYPE)  ( ADR CNT -- )
   #LP (CHKOUT) IOERR  // SEND TO PRINTER
   (TYPE) ;

But I would have three words for TYPE in the kernel:
TYPE , (TYPE) , and <TYPE> .
QTYPE is similar.
QTYPE or quote type is for printing anything that may contain unprintable characters that could make the display do undesirable things, such as an index for a range of blocks or listing a block that may contain data instead of text.
Since Fleet Forth is an ITC Forth and each reference to a word is only one cell, I tried a slightly different approach. A mixing of a deferred word and a normal colon definition.

Code: Select all

SCR# 29 
// SYSTEM DEFERRED WORDS & KIN
HEX
// MULTITASKING
DEFER PAUSE     ' NOOP IS PAUSE
DEFER ?KEY
DEFER EXPECT
DEFER EMIT
: TYPE   (TYPE) PAUSE ;
// QUOTE TYPE
: QTYPE   (QTYPE) PAUSE ;
// INITIAL CODE TO BE EXECUTED
DEFER INITIAL   ' NOOP IS INITIAL
DEFER ERR       ' NOOP IS ERR
DEFER VALID?
DEFER DR/W
DEFER RR/W

And the words which redirect output:

Code: Select all

SCR# 38 
// CONSOLE PRINTER
HEX
: CONSOLE  ( -- )
   #LP CLOSE  CLRCHN
   ['] (EMIT) IS EMIT
   ['] (TYPE) (IS) TYPE
   ['] (QTYPE) (IS) QTYPE
   [ HERE >A ]
   ['] (EXPECT) IS EXPECT ;
: PRINTER  ( -- )
   #LP CLOSE
   0 0  #LP DUP #LP2 (OPEN) IOERR
   ['] (PEMIT) IS EMIT
   ['] (PTYPE) (IS) TYPE
   ['] (PQTYPE) (IS) QTYPE
   BRANCH [ A> , ] ; -2 ALLOT

SCR# 39 
// LOGGER
HEX
: LOGGER  ( -- )
   PRINTER
   ['] (LEMIT) IS EMIT
   ['] (LTYPE) (IS) TYPE
   ['] (LQTYPE) (IS) QTYPE
   ['] (LEXPECT) IS EXPECT ;

The idea is the first cell is the 'deferred' part followed by code common to all 'vectors' this 'deferred' word is set to execute. I know this isn't portable, but maybe it can be made portable with a new word DEFER: . Each system to use this idea would have to define their own version of DEFER: because it is system dependent. In Fleet Forth it would be something like this:

Code: Select all

: DEFER:  ( -- COLON-SYS )
   :  COMPILE -SET ;CODE
   DO-COLON JMP,  END-CODE

I haven't tried this yet because I'm away from my desktop ( it has the VICE Commodore simulator ) . On a large system this idea may not have much merit, but eliminating some unnecessary names on a small system may be worthwhile. At the very least, it's an idea to play with.

[JimBoyd]

My implementation of DEFER: for Fleet Forth works but I don't have to implement it for what I'm doing since the words that alter the first cell in the body of TYPE and QTYPE are part of the Fleet Forth system. It is for portable use of this idea outside the system code.
One thing needed changed. -SET is a word that new DEFERred words are set to execute. It aborts showing the name of the word that is not set with the message " NOT SET". If an unset DEFERred word is used from the console, it shows that EXECUTE is not set. This is because EXECUTE doesn't nest and it's not worth the extra code to fix.
-SET works with a DEFERred word but not with a colon definition ( which is what a Fleet Forth DEFER: word effectively is ) so I defined -SET2

Code: Select all

: -SET2
   R>  // REMOVE ONE LEVEL OF NESTING
   BRANCH [ ' -SET >BODY , ] ;  // AND BRANCH TO THE BODY OF -SET
   -2 ALLOT  // RECLAIM MEMORY USED BY UNNEEDED EXIT
: DEFER:  ( -- SYS )
   : COMPILE -SET2 ;CODE
   ' : @ JMP,  END-CODE

I realize that the following would also work:

Code: Select all

: DEFER:  ( -- SYS )
   : COMPILE -SET2 ;

The first way causes the DEFER: words to have a code field different from colon definitions even though the code pointed to is just a jump to do-colon. This allows words like IS to identify DEFER: words by their code field.

[JimBoyd]

JimBoyd wrote:

JimBoyd wrote:

I added to my system loader the version of the Auxiliary stack that grows toward lower memory.

Taking multitasking into consideration, background tasks do not get their own Auxiliary stack or even a portion of the Auxiliary stack.

I reimplemented the Auxiliary stack support in the kernel. The constants identifying the location of the Aux stack were replaced with user variables and the word AP! redefined accordingly. The Aux stack can now be used by background tasks. I haven't tested this yet. It shouldn't be any more difficult than sharing the Data and Return stacks. The words >A , A> and the words built on these two are still implemented in the system loader. The versions I have are code words and the location of the Aux stack is an area of unused memory on page two. 24 cells are available for the Aux stack. >A and A> can be redefined so the Aux stack could be anywhere in memory and as large ( or small) as needed, within the constraint of available memory. Each task could even have its own Aux stack.

[JimBoyd]

I have four square root words for Fleet Forth in source code on a 'library' disk. SQRT takes an unsigned double number and returns an unsigned single number. DSQRT takes an unsigned quad precision number and returns an unsigned double. They both truncate the result.
The problem is with the versions that round the result. With the truncating versions, the result of the square root of an unsigned double will fit in an unsigned single and the result of the square root of an unsigned quad will fit in an unsigned double. When the square root is rounded, the top 65,000 or so unsigned double numbers will have a result that rounds to 65536 or $10000. The top 4 billion or so unsigned quad precision numbers will return a rounded result that is 4294967296 or $100000000.
If SQRTR , the rounding version of SQRT , returns an unsigned single precision number then the result returned for those top 65,000 or so unsigned double numbers will be zero due to overflow of the result. It could be changed to return a double number to return the entire result. The high cell would be zero most of the time and one for those largest double numbers. Likewise if DSQRTR , the rounding version of SQRT , returns an unsigned double then the result for those 4 billion top numbers will be zero.
It seems odd for the rounding versions to return a different size number than their truncating counterparts. Any suggestions?

[JimBoyd]

I forgot to include this in my explanation:

Code: Select all

// TRUNCATING
SQRT  ( UD -- U )
DSQRT  ( UQ -- UD )
// ROUNDING
SQRT  ( UD -- U )
DSQRT  ( UQ -- UD )

or maybe they should be:

Code: Select all

// TRUNCATING
SQRT  ( UD -- U )
DSQRT  ( UQ -- UD )
// ROUNDING
SQRT  ( UD -- UD )
DSQRT  ( UQ -- UQ )

or even

Code: Select all

// TRUNCATING
SQRT  ( UD -- UD )
DSQRT  ( UQ -- UQ )
// ROUNDING
SQRT  ( UD -- UD )
DSQRT  ( UQ -- UQ )

and I might need better names.

[BigEd]

Hmm. Interesting problem - there will always be too many possible answers. Would it be too painful to say that these words return a full precision result, rather than half precision? That feels like the right answer, as the calling program presumably needs to be prepared to use the result, and the result might indeed be too large for half precision.

Is there a means of signalling overflow?

(I'm reminded of the difficulty in fixed-point that -1 is expressible, but +1 is not, so you can't square -1)

[GARTHWILSON]

Are the square-root functions primitives or secondaries? Are you willing to make them any longer? Can you just see if the next cell above what you'll return is non-0, and if so, just decrement the returned result from 0 to FFFF (or FFFF:FFFF), keeping in mind that the inputs and outputs are unsigned? (Whether rounded or truncated, the result is usually inexact anyway.) An unconventional alternative would be to return a flag along with the answer, the flag telling if the supposedly rounded answer is actually truncated.

[BigEd]

That's a thought - a saturating rounding square root, which returns all-ones as the largest available value.

[JimBoyd]

GARTHWILSON wrote:

Are the square-root functions primitives or secondaries?

They are primitives.

Quote:

Are you willing to make them any longer?

Yes, they wouldn't have to be much longer. I'm looking for some consistency with the size of the returned values ( single, double, quad.)

Quote:

Can you just see if the next cell above what you'll return is non-0, and if so, just decrement the returned result from 0 to FFFF (or FFFF:FFFF), keeping in mind that the inputs and outputs are unsigned? (Whether rounded or truncated, the result is usually inexact anyway.)

Possibly. I'll need to give it some thought to see which I like better, that or returning a result the same size as the input.

Quote:

An unconventional alternative would be to return a flag along with the answer, the flag telling if the supposedly rounded answer is actually truncated.

I'm not really a fan of that one.

[JimBoyd]

I don't know if there is prior code that can be a precedent for this.

[JimBoyd]

Here is the code for the truncating square root word SQRT :

Code: Select all

HEX
CODE SQRT  ( UD -- U )
   TYA,  5 # LDY,
   BEGIN,  N ,Y STA,  DEY,
   0< UNTIL,
   10 # LDY,
   BEGIN,
      2 ,X ASL,  3 ,X ROL,
      0 ,X ROL,  1 ,X ROL,
      N    ROL,  N 1+ ROL,
      N 2+ ROL,
      2 ,X ASL,  3 ,X ROL,
      0 ,X ROL,  1 ,X ROL,
      N    ROL,  N 1+ ROL,
      N 2+ ROL,
      N 3 + ASL,  N 4 + ROL,
      N 5 + ROL,  SEC,
      N 3 + ROL,  N 4 + ROL,
      N 5 + ROL,  SEC,
      N    LDA,  N 3 + SBC,
      N 1+ LDA,  N 4 + SBC,
      N 2+ LDA,  N 5 + SBC,
      CS IF,
         N    LDA,  N 3 + SBC,  N    STA,
         N 1+ LDA,  N 4 + SBC,  N 1+ STA,
         N 2+ LDA,  N 5 + SBC,  N 2+ STA,
         N 3 + LDA,  2 # ORA,  N 3 + STA,
      THEN,
      N 5 + LSR,
      N 4 + ROR,  N 3 + ROR,
      DEY,
   0= UNTIL,
   N 3 + LDA,  2 ,X STA,
   N 4 + LDA,  3 ,X STA,
   POP JMP,
END-CODE

The rounding square root word SQRTR :

Code: Select all

HEX
CODE SQRTR  ( UD -- U )
   TYA,  5 # LDY,
   BEGIN,  N ,Y STA,  DEY,
   0< UNTIL,
   11 # LDY,
   BEGIN,
      2 ,X ASL,  3 ,X ROL,
      0 ,X ROL,  1 ,X ROL,
      N    ROL,  N 1+ ROL,
      N 2+ ROL,
      2 ,X ASL,  3 ,X ROL,
      0 ,X ROL,  1 ,X ROL,
      N    ROL,  N 1+ ROL,
      N 2+ ROL,
      N 3 + ASL,  N 4 + ROL,
      N 5 + ROL,  SEC,
      N 3 + ROL,  N 4 + ROL,
      N 5 + ROL,  SEC,
      N    LDA,  N 3 + SBC,
      N 1+ LDA,  N 4 + SBC,
      N 2+ LDA,  N 5 + SBC,
      CS IF,
         N    LDA,  N 3 + SBC,  N    STA,
         N 1+ LDA,  N 4 + SBC,  N 1+ STA,
         N 2+ LDA,  N 5 + SBC,  N 2+ STA,
         N 3 + LDA,  2 # ORA,  N 3 + STA,
      THEN,
      N 5 + LSR,
      N 4 + ROR,  N 3 + ROR,
      DEY,
   0= UNTIL,
   N 5 + LSR,
   N 4 + ROR,  N 3 + ROR,
   N 3 + LDA,  0 # ADC,
   2 ,X STA,
   N 4 + LDA,  0 # ADC,
   3 ,X STA,
   POP JMP,
END-CODE

And the version of the rounding square root word which returns a double:

Code: Select all

HEX
CODE SQRTR  ( UD -- UD2 )
   TYA,  5 # LDY,
   BEGIN,  N ,Y STA,  DEY,
   0< UNTIL,
   11 # LDY,
   BEGIN,
      2 ,X ASL,  3 ,X ROL,
      0 ,X ROL,  1 ,X ROL,
      N    ROL,  N 1+ ROL,
      N 2+ ROL,
      2 ,X ASL,  3 ,X ROL,
      0 ,X ROL,  1 ,X ROL,
      N    ROL,  N 1+ ROL,
      N 2+ ROL,
      N 3 + ASL,  N 4 + ROL,
      N 5 + ROL,  SEC,
      N 3 + ROL,  N 4 + ROL,
      N 5 + ROL,  SEC,
      N    LDA,  N 3 + SBC,
      N 1+ LDA,  N 4 + SBC,
      N 2+ LDA,  N 5 + SBC,
      CS IF,
         N    LDA,  N 3 + SBC,  N    STA,
         N 1+ LDA,  N 4 + SBC,  N 1+ STA,
         N 2+ LDA,  N 5 + SBC,  N 2+ STA,
         N 3 + LDA,  2 # ORA,  N 3 + STA,
      THEN,
      N 5 + LSR,
      N 4 + ROR,  N 3 + ROR,
      DEY,
   0= UNTIL,
   N 5 + LSR,
   N 4 + ROR,  N 3 + ROR,
   N 3 + LDA,  0 # ADC,
   2 ,X STA,
   N 4 + LDA,  0 # ADC,
   3 ,X STA,
   N 5 + LDA,  0 # ADC,
   0 ,X STA,
   0 # LDA,  1 ,X STA,
   NEXT JMP,
END-CODE

The version of SQRTR ( the rounding sqrare root word) which returns a double is only ten bytes longer than the one which returns a single.

GARTHWILSON wrote:

Whether rounded or truncated, the result is usually inexact anyway.

Well, exact as you can be when discarding the fractional part. With the truncating version, if U squared does not equal UD then UD will be between U squared and (U+1) squared.