CREATE tools.txt  \ Leo Wong  2 April 02003 fyj +
\ !+ (.) ++ ,s -digit .c 4dup <next> >d >n ?? @+ alias aliases array
\ cell k* macro many: noop padlength preparse s= tools.txt

1 CELLS CONSTANT cell
-1 CELLS CONSTANT -cell
: cell-  ( a1 -- a2 )  cell - ;
S" /PAD" ENVIRONMENT? 0= [IF] 84 [THEN] CONSTANT padlength
: noop ( -- ) ;
: 4dup  ( a b c d -- a b c d a b c d )  2OVER 2OVER ;
: .c
   state @ 
   IF  POSTPONE [CHAR]  POSTPONE EMIT
   ELSE CHAR EMIT THEN ; IMMEDIATE
: s=  ( a1 u1 a2 u2 -- flag ) COMPARE 0= ;
: k*  ( n -- 1024*n )  1024 * ;
: @+  ( a -- a' x )  DUP CELL+ SWAP @ ;
: !+  ( a x -- a+  )  OVER ! CELL+ ;
: ++  ( a -- )  1 SWAP +! ;
: -digit  ( c -- n )  [CHAR] 0 -  DUP 9 >  7 AND - ;
: (.)  ( n -- ca u )  DUP ABS 0 <#  #S  ROT SIGN  #> ;
: >d  ( a u -- d )  0 0 2SWAP >NUMBER NIP NIP ;
: >n  ( a u -- n )  >d D>S ;

: array  \ Define an array of n cells
   CREATE ( +n -- ) CELLS ALLOT
   DOES> ( +n -- a ) SWAP CELLS + ;

: ,s  ( x1 ... xn n -- )  \ Compile n values
   BEGIN ?DUP WHILE  DUP ROLL ,  1-  REPEAT ;
: exchange ( a1 a2 -- )  2DUP 2>R  @ SWAP @  R> !  R> ! ;
: 2exchange  ( a1 a2 -- )  2DUP 2>R  2@ ROT 2@  R> 2!  R> 2! ;
: ??  \ by Wil Baden: IF <word> THEN
   S" IF" EVALUATE BL WORD COUNT EVALUATE  S" THEN" EVALUATE ;
   IMMEDIATE
: macro  \ by Wil Baden
   : CHAR PARSE  POSTPONE SLITERAL  POSTPONE EVALUATE POSTPONE ;
   IMMEDIATE ;
: alias  ( xt -- )  \ alias <name>
   >R : R> COMPILE, POSTPONE ; ;
: aliases  ( xt -- xt )  DUP alias ;
: <next>  BL WORD COUNT ;
: preparse >IN @ >R <next> R> >IN ! ;
: many:  ( ... -- ... )   \ Usage: many <word> ... ;
   ' >R
   BEGIN
     preparse 2DUP S" ;" COMPARE
   WHILE
     2DUP S" (" s= IF 2DROP POSTPONE (  ELSE
     2DUP S" \" s= IF 2DROP POSTPONE \  ELSE
               NIP IF R@ EXECUTE        ELSE
                      REFILL 0= ABORT" ; missing after many"
     THEN THEN THEN
   REPEAT 2DROP
   BL WORD DROP  \ Skip ;
   R> DROP ;