ANEW --COMMON--                               \  Wil Baden  2002-03-17

\  *******************************************************************
\  *                                                                 *
\  *  Wil Baden  2003-02-17                                          *
\  *                                                                 *
\  *                           Common Use                            *
\  *                                                                 *
\  *  These will be defined when used.                               *
\  *                                                                 *
\  *       !++            /PAD           C!++           HIWORD       *
\  *       #BACKSPACE-CHAR               C@++           LOWORD       *
\  *       #BITS/CELL     @++            EMITS          MAX-N        *
\  *       #TAB-CHAR      ADDRESS-UNIT-BITS             SIGN-BIT     *
\  *       /COUNTED-STRING               ENUM           [VOID]       *
\  *                                                                 *
\  *  Deprecated:                                                    *
\  *                                                                 *
\  *       ++             -CELL          CELL           CELL-        *
\  *       !+             Append-Char    LEXEME                      *
\  *       /SPLIT         BL-Scan        Split-Next-Line             *
\  *       @+             BL-Skip        View-Next-Line              *
\  *                                                                 *
\  *******************************************************************

\  *******************************************************************
\  *                           Common Use                            *
\  *******************************************************************

\  -CELL                        ( -- n )   [Not used]
\     Negative of address units in a cell.

\  /COUNTED-STRING          ( -- n )
\     Maximum size of a counted string, in characters.

\  /PAD                         ( -- n )
\     Size of the scratch area pointed to by `PAD`, in characters.

\  ADDRESS-UNIT-BITS            ( -- n )
\     Size of one address unit, in bits.

\  #BACKSPACE-CHAR               ( -- n )
\     The backspace character.  "the backspace character"

\  CELL                         ( -- n )   [Not used]
\     Address units (i.e. bytes) in a cell.

\  CELL-                        ( addr -- addr' )  [Not used]
\     Decrement address by one cell.

\  ENUM                         ( n1 "name" -- n2 )
\      Define name as a constant with value n1, then increment n1 to 
\      return n2. Useful for defining a sequential list of constants. 

\  ++                         ( addr -- )  [Not used]
\     Add 1 at _addr_.  "increment"

\  LEXEME                       ( "name" -- str len )  [Not used]
\     Get the next word on the line as a character string. If it's a 
\     single character, use it as the delimiter to get a string. This 
\     function has been replaced by `BL WORD COUNT Check-Quote`, 
\     `PARSE-WORD Check-Quote`, and `Next-Word Check-Quote`. 

\  #TAB-CHAR                    ( -- n )
\     The tab character,  9.  "the tab character"

\  TH                           ( a i -- a' )

\  UNDER+                       ( x y z -- x+z y )
\     Add value to the number just under the top stack item. (_Thinking
\     Forth_, p. 171)

\  ************************  CELL Derivatives  *************************

 1 CELLS CONSTANT CELL

-1 CELLS CONSTANT -CELL

: CELL- S" 4 - " EVALUATE ; IMMEDIATE

\  ***********************  Character Constants  ***********************

S" /PAD" ENVIRONMENT? 0= [IF] 84 [THEN] 
	CONSTANT /PAD

S" ADDRESS-UNIT-BITS"  ENVIRONMENT? 0= [IF] 8 [THEN] 
	CONSTANT  ADDRESS-UNIT-BITS 

S" MAX-N"  ENVIRONMENT? 0= [IF] TRUE 1 RSHIFT [THEN] 
	CONSTANT  MAX-N 

S" /COUNTED-STRING"  ENVIRONMENT? 0= [IF] 256 [THEN] 
    CONSTANT  /COUNTED-STRING 

 08 CONSTANT  #Backspace-Char

 09 CONSTANT  #Tab-Char

TRUE 1 RSHIFT INVERT CONSTANT  Sign-Bit

Address-Unit-Bits CELLS  CONSTANT  #Bits/Cell

Address-Unit-Bits chars  CONSTANT  #Bits/Char

FALSE CONSTANT  [VOID]  IMMEDIATE

   4 VALUE #Tab-Spaces

\  ******************************  ENUM  *******************************

\ : ENUM				( n "name" -- n+1 )
\     dup CONSTANT  1+ ;

: ENUM				( n -- n+1 )
    >IN @ >R  PARSE-WORD
    NUMBER? IF
        NIP  R> DROP
    ELSE
        R> >IN !
    THEN
    dup CONSTANT 1+ ;

\ : ++ ( addr -- )
\     1 SWAP +! ;

\  *************************  Miscellaneous  *************************

: !++  ( a x -- a' )  over !  CELL+ ;

: @++  ( a -- a' x )  dup CELL+ SWAP  @ ;

: C!++  ( a c -- a' )  over C!  CHAR+ ;

: C@++  ( a -- a' c )  dup CHAR+ SWAP  C@ ;

\  *****************************  >QPAD  *****************************

    CREATE  QHEAD  0 ,
    CREATE  QBUF  1 CELLS ,  1024 chars ALLOT
    
    : QPAD          ( -- addr )
        QHEAD @  896 AND chars  QBUF  dup @ +  + ;

: >QPAD         ( addr n -- addr )
    128 QHEAD +!  QPAD  dup >R  PLACE  R> ;


\\   //   \\   //   \\   //   \\   //   \\   //   \\   //   \\   //   \\