[pforth] / fth / t_corex.fth

\ @(#) t_corex.fth 98/03/16 1.2
\ Test ANS Forth Core Extensions
\
\ Copyright 1994 3DO, Phil Burk

INCLUDE? }T{  t_tools.fth

ANEW TASK-T_COREX.FTH

DECIMAL

TEST{

\ ==========================================================
T{ 1 2 3 }T{ 1 2 3 }T

\  ----------------------------------------------------- .(
T{ 27 .( IF YOU SEE THIS THEN .( WORKED!) }T{ 27 }T

CR .(     1234 - SHOULD LINE UP WITH NEXT LINE.) CR 1234 8 .R CR

T{ .( )   987   .( TEST NULL STRING IN .( ) CR }T{ 987 }T

\  ----------------------------------------------------- 0<>
T{ 5 0<> }T{ TRUE }T
T{ 0 0<> }T{ 0 }T
T{ -1000 0<> }T{ TRUE }T

\  ----------------------------------------------------- 2>R 2R> 2R@
: T2>R  ( -- .... )
    17
    20 5 2>R
    19
    2R@
    37
    2R>
\ 2>R should be the equivalent of SWAP >R >R so this next construct
\ should reduce to a SWAP.
    88 77 2>R R> R>
;
T{ T2>R }T{ 17 19 20 5 37 20 5 77 88 }T

\  ----------------------------------------------------- :NONAME
T{ :NONAME  100 50 + ; EXECUTE }T{ 150 }T

\  ----------------------------------------------------- <>
T{ 12345 12305 <> }T{ TRUE }T
T{ HEX 98765432 98765432 DECIMAL <> }T{ 0 }T

\  ----------------------------------------------------- ?DO
: T?DO  ( n -- sum_n ) 0 SWAP 1+ 0 ?DO i + LOOP ;
T{ 0 T?DO }T{ 0 }T
T{ 4 T?DO }T{ 10 }T

\  ----------------------------------------------------- AGAIN
: T.AGAIN  ( n --  )
    BEGIN
        DUP .
        DUP 6 < IF EXIT THEN
        1-
    AGAIN
;
T{ 10 T.AGAIN CR }T{ 5 }T

\  ----------------------------------------------------- C"
: T.C"  ( -- $STRING )
    C" x5&"
;
T{ T.C"  C@  }T{ 3 }T
T{ T.C"  COUNT DROP C@  }T{ CHAR x }T
T{ T.C"  COUNT DROP CHAR+ C@ }T{  CHAR 5 }T
T{ T.C"  COUNT DROP 2 CHARS + C@  }T{ CHAR & }T

\  ----------------------------------------------------- CASE
: T.CASE  ( N -- )
    CASE
        1 OF 101 ENDOF
        27 OF 892 ENDOF
        941 SWAP \ default
    ENDCASE
;
T{ 1 T.CASE }T{ 101 }T
T{ 27 T.CASE }T{ 892 }T
T{ 49 T.CASE }T{ 941 }T

\  ----------------------------------------------------- COMPILE,
: COMPILE.SWAP    ['] SWAP COMPILE, ; IMMEDIATE
: T.COMPILE,
    19 20 27 COMPILE.SWAP 39
;
T{ T.COMPILE, }T{ 19 27 20 39 }T

\  ----------------------------------------------------- CONVERT
: T.CONVERT
    0 S>D  S" 1234xyz" DROP CONVERT
    >R
    D>S
    R> C@
;
T{ T.CONVERT }T{ 1234 CHAR x }T

\  ----------------------------------------------------- ERASE
: T.COMMA.SEQ  ( n -- , lay down N sequential bytes )
    0 ?DO I C, LOOP
;
CREATE T-ERASE-DATA   64 T.COMMA.SEQ
T{ T-ERASE-DATA 8 + C@ }T{ 8 }T
T{ T-ERASE-DATA 7 + 3 ERASE
T{ T-ERASE-DATA 6 + C@ }T{ 6 }T
T{ T-ERASE-DATA 7 + C@ }T{ 0 }T
T{ T-ERASE-DATA 8 + C@ }T{ 0 }T
T{ T-ERASE-DATA 9 + C@ }T{ 0 }T
T{ T-ERASE-DATA 10 + C@ }T{ 10 }T

\  ----------------------------------------------------- FALSE
T{ FALSE }T{ 0 }T

\  ----------------------------------------------------- HEX
T{ HEX 10 DECIMAL }T{ 16 }T

\  ----------------------------------------------------- MARKER
: INDIC?  ( <name> -- ifInDic , is the following word defined? )
    bl word find
    swap drop 0= 0=
;
create FOOBAR
MARKER MYMARK  \ create word that forgets itself
create GOOFBALL
MYMARK
T{ indic? foobar  indic? mymark indic? goofball }T{ true false false }T

\  ----------------------------------------------------- NIP
T{ 33 44 55 NIP  }T{ 33 55 }T

\  ----------------------------------------------------- PARSE
: T.PARSE  ( char <string>char -- addr num )
    PARSE
    >R  \ save length
    PAD R@ CMOVE  \ move string to pad
    PAD R>
;
T{ CHAR % T.PARSE wxyz% SWAP C@ }T{  4  CHAR w }T

\  ----------------------------------------------------- PICK
T{ 13 12 11 10 2 PICK  }T{ 13 12 11 10 12 }T

\  ----------------------------------------------------- QUERY
T{ ' QUERY 0<> }T{ TRUE }T

\  ----------------------------------------------------- REFILL
T{ ' REFILL 0<> }T{ TRUE }T

\  ----------------------------------------------------- RESTORE-INPUT
T{ : T.SAVE-INPUT SAVE-INPUT RESTORE-INPUT ; T.SAVE-INPUT }T{ 0 }T

\ TESTING SAVE-INPUT and RESTORE-INPUT with a string source

VARIABLE SI_INC 0 SI_INC !

: SI1
   SI_INC @ >IN +!
   15 SI_INC !
;

: S$ S" SAVE-INPUT SI1 RESTORE-INPUT 12345" ;

T{ S$ EVALUATE SI_INC @ }T{ 0 2345 15 }T

\  ----------------------------------------------------- ROLL
T{ 15 14 13 12 11 10 0 ROLL  }T{  15 14 13 12 11 10 }T
T{ 15 14 13 12 11 10 1 ROLL  }T{  15 14 13 12 10 11 }T
T{ 15 14 13 12 11 10 2 ROLL  }T{  15 14 13 11 10 12 }T
T{ 15 14 13 12 11 10 3 ROLL  }T{  15 14 12 11 10 13 }T
T{ 15 14 13 12 11 10 4 ROLL  }T{  15 13 12 11 10 14 }T

\  ----------------------------------------------------- SOURCE-ID
T{ SOURCE-ID 0<> }T{ TRUE }T
T{ : T.SOURCE-ID  S" SOURCE-ID" EVALUATE  ;   T.SOURCE-ID }T{ -1 }T

\  ----------------------------------------------------- SPAN
T{ ' SPAN 0<>  }T{ TRUE }T

\  ----------------------------------------------------- TO VALUE
333 VALUE  MY-VALUE
T{ MY-VALUE }T{ 333 }T
T{ 1000 TO MY-VALUE   MY-VALUE }T{ 1000 }T
: TEST.VALUE  ( -- 19 100 )
    100 TO MY-VALUE
    19
    MY-VALUE
;
T{ TEST.VALUE }T{ 19 100 }T

\  ----------------------------------------------------- TRUE
T{ TRUE }T{ 0 0= }T

\  ----------------------------------------------------- TUCK
T{ 44 55 66 TUCK }T{ 44 66 55 66 }T

\  ----------------------------------------------------- U.R
HEX CR .(     ABCD4321 - SHOULD LINE UP WITH NEXT LINE.) CR
ABCD4321 C U.R CR DECIMAL

\  ----------------------------------------------------- U>
T{ -5 3 U> }T{ TRUE }T
T{ 10 8 U> }T{ TRUE }T

\  ----------------------------------------------------- UNUSED
T{ UNUSED 0> }T{ TRUE }T

\  ----------------------------------------------------- WITHIN
T{  4  5 10 WITHIN }T{ 0 }T
T{  5  5 10 WITHIN }T{ TRUE }T
T{  9  5 10 WITHIN }T{ TRUE }T
T{ 10  5 10 WITHIN }T{ 0 }T

T{  4  10 5 WITHIN }T{ TRUE }T
T{  5  10 5 WITHIN }T{ 0 }T
T{  9  10 5 WITHIN }T{ 0 }T
T{ 10  10 5 WITHIN }T{ TRUE }T

T{  -6  -5 10 WITHIN }T{ 0 }T
T{  -5  -5 10 WITHIN    }T{ TRUE }T
T{  9  -5 10 WITHIN    }T{ TRUE }T
T{ 10  -5 10 WITHIN }T{ 0 }T


\  ----------------------------------------------------- [COMPILE]
: T.[COMPILE].IF  [COMPILE] IF ; IMMEDIATE
: T.[COMPILE]  40 0> T.[COMPILE].IF 97 ELSE 53 THEN 97 = ;
T{ T.[COMPILE] }T{ TRUE }T

\  ----------------------------------------------------- \

\ .( TESTING DO +LOOP with large and small increments )

\ Contributed by Andrew Haley
0 invert CONSTANT MAX-UINT
0 INVERT 1 RSHIFT CONSTANT MAX-INT
0 INVERT 1 RSHIFT INVERT    CONSTANT MIN-INT
MAX-UINT 8 RSHIFT 1+ CONSTANT USTEP
USTEP NEGATE CONSTANT -USTEP
MAX-INT 7 RSHIFT 1+ CONSTANT STEP
STEP NEGATE CONSTANT -STEP

VARIABLE BUMP

T{ : GD8 BUMP ! DO 1+ BUMP @ +LOOP ; }T{ }T

T{ 0 MAX-UINT 0 USTEP GD8 }T{ 256 }T
T{ 0 0 MAX-UINT -USTEP GD8 }T{ 256 }T

T{ 0 MAX-INT MIN-INT STEP GD8 }T{ 256 }T
T{ 0 MIN-INT MAX-INT -STEP GD8 }T{ 256 }T

\ Two's complement arithmetic, wraps around modulo wordsize
\ Only tested if the Forth system does wrap around, use of conditional
\ compilation deliberately avoided

MAX-INT 1+ MIN-INT = CONSTANT +WRAP?
MIN-INT 1- MAX-INT = CONSTANT -WRAP?
MAX-UINT 1+ 0=       CONSTANT +UWRAP?
0 1- MAX-UINT =      CONSTANT -UWRAP?

: GD9  ( n limit start step f result -- )
   >R IF GD8 ELSE 2DROP 2DROP R@ THEN }T{ R> }T
;

T{ 0 0 0  USTEP +UWRAP? 256 GD9
T{ 0 0 0 -USTEP -UWRAP?   1 GD9
T{ 0 MIN-INT MAX-INT  STEP +WRAP? 1 GD9
T{ 0 MAX-INT MIN-INT -STEP -WRAP? 1 GD9

\ --------------------------------------------------------------------------
\ .( TESTING DO +LOOP with maximum and minimum increments )

: (-MI) MAX-INT DUP NEGATE + 0= IF MAX-INT NEGATE ELSE -32767 THEN ;
(-MI) CONSTANT -MAX-INT

T{ 0 1 0 MAX-INT GD8  }T{ 1 }T
T{ 0 -MAX-INT NEGATE -MAX-INT OVER GD8  }T{ 2 }T

T{ 0 MAX-INT  0 MAX-INT GD8  }T{ 1 }T
T{ 0 MAX-INT  1 MAX-INT GD8  }T{ 1 }T
T{ 0 MAX-INT -1 MAX-INT GD8  }T{ 2 }T
T{ 0 MAX-INT DUP 1- MAX-INT GD8  }T{ 1 }T

T{ 0 MIN-INT 1+   0 MIN-INT GD8  }T{ 1 }T
T{ 0 MIN-INT 1+  -1 MIN-INT GD8  }T{ 1 }T
T{ 0 MIN-INT 1+   1 MIN-INT GD8  }T{ 2 }T
T{ 0 MIN-INT 1+ DUP MIN-INT GD8  }T{ 1 }T

\ ----------------------------------------------------------------------------
\ .( TESTING number prefixes # $ % and 'c' character input )
\ Adapted from the Forth 200X Draft 14.5 document

VARIABLE OLD-BASE
DECIMAL BASE @ OLD-BASE !
T{ #1289 }T{ 1289 }T
T{ #-1289 }T{ -1289 }T
T{ $12eF }T{ 4847 }T
T{ $-12eF }T{ -4847 }T
T{ %10010110 }T{ 150 }T
T{ %-10010110 }T{ -150 }T
T{ 'z' }T{ 122 }T
T{ 'Z' }T{ 90 }T
\ Check BASE is unchanged
T{ BASE @ OLD-BASE @ = }T{ TRUE }T

\ Repeat in Hex mode
16 OLD-BASE ! 16 BASE !
T{ #1289 }T{ 509 }T
T{ #-1289 }T{ -509 }T
T{ $12eF }T{ 12EF }T
T{ $-12eF }T{ -12EF }T
T{ %10010110 }T{ 96 }T
T{ %-10010110 }T{ -96 }T
T{ 'z' }T{ 7a }T
T{ 'Z' }T{ 5a }T
\ Check BASE is unchanged
T{ BASE @ OLD-BASE @ = }T{ TRUE }T   \ 2

DECIMAL
\ Check number prefixes in compile mode
T{ : nmp  #8327 $-2cbe %011010111 ''' ; nmp }T{ 8327 -11454 215 39 }T

\  ----------------------------------------------------- ENVIRONMENT?

T{ s" unknown-query-string" ENVIRONMENT? }T{ FALSE }T
T{ s" MAX-CHAR" ENVIRONMENT? }T{ 255 TRUE }T
T{ s" ADDRESS-UNITS-BITS" ENVIRONMENT? }T{ 8 TRUE }T

}TEST
Commit	Line	Data
8e9db35f PB	1	\ @(#) t_corex.fth 98/03/16 1.2
	2	\ Test ANS Forth Core Extensions
	3	\
	4	\ Copyright 1994 3DO, Phil Burk
	5
	6	INCLUDE? }T{ t_tools.fth
	7
	8	ANEW TASK-T_COREX.FTH
	9
	10	DECIMAL
	11
8e9db35f PB	12	TEST{
	13
	14	\ ==========================================================
	15	T{ 1 2 3 }T{ 1 2 3 }T
	16
	17	\ ----------------------------------------------------- .(
	18	T{ 27 .( IF YOU SEE THIS THEN .( WORKED!) }T{ 27 }T
	19
	20	CR .( 1234 - SHOULD LINE UP WITH NEXT LINE.) CR 1234 8 .R CR
	21
	22	T{ .( ) 987 .( TEST NULL STRING IN .( ) CR }T{ 987 }T
	23
	24	\ ----------------------------------------------------- 0<>
	25	T{ 5 0<> }T{ TRUE }T
	26	T{ 0 0<> }T{ 0 }T
	27	T{ -1000 0<> }T{ TRUE }T
	28
	29	\ ----------------------------------------------------- 2>R 2R> 2R@
	30	: T2>R ( -- .... )
	31	17
	32	20 5 2>R
	33	19
	34	2R@
	35	37
	36	2R>
	37	\ 2>R should be the equivalent of SWAP >R >R so this next construct
	38	\ should reduce to a SWAP.
	39	88 77 2>R R> R>
	40	;
	41	T{ T2>R }T{ 17 19 20 5 37 20 5 77 88 }T
	42
	43	\ ----------------------------------------------------- :NONAME
	44	T{ :NONAME 100 50 + ; EXECUTE }T{ 150 }T
	45
	46	\ ----------------------------------------------------- <>
	47	T{ 12345 12305 <> }T{ TRUE }T
	48	T{ HEX 98765432 98765432 DECIMAL <> }T{ 0 }T
	49
	50	\ ----------------------------------------------------- ?DO
	51	: T?DO ( n -- sum_n ) 0 SWAP 1+ 0 ?DO i + LOOP ;
	52	T{ 0 T?DO }T{ 0 }T
	53	T{ 4 T?DO }T{ 10 }T
	54
	55	\ ----------------------------------------------------- AGAIN
	56	: T.AGAIN ( n -- )
	57	BEGIN
	58	DUP .
	59	DUP 6 < IF EXIT THEN
	60	1-
	61	AGAIN
	62	;
	63	T{ 10 T.AGAIN CR }T{ 5 }T
	64
	65	\ ----------------------------------------------------- C"
	66	: T.C" ( -- $STRING )
	67	C" x5&"
	68	;
	69	T{ T.C" C@ }T{ 3 }T
	70	T{ T.C" COUNT DROP C@ }T{ CHAR x }T
	71	T{ T.C" COUNT DROP CHAR+ C@ }T{ CHAR 5 }T
	72	T{ T.C" COUNT DROP 2 CHARS + C@ }T{ CHAR & }T
	73
	74	\ ----------------------------------------------------- CASE
	75	: T.CASE ( N -- )
76	CASE
77	1 OF 101 ENDOF
78	27 OF 892 ENDOF
79	941 SWAP \ default
80	ENDCASE
81	;
82	T{ 1 T.CASE }T{ 101 }T
83	T{ 27 T.CASE }T{ 892 }T
84	T{ 49 T.CASE }T{ 941 }T
85
86	\ ----------------------------------------------------- COMPILE,
87	: COMPILE.SWAP ['] SWAP COMPILE, ; IMMEDIATE
88	: T.COMPILE,
89	19 20 27 COMPILE.SWAP 39
90	;
91	T{ T.COMPILE, }T{ 19 27 20 39 }T
92
93	\ ----------------------------------------------------- CONVERT
94	: T.CONVERT
95	0 S>D S" 1234xyz" DROP CONVERT
96	>R
97	D>S
98	R> C@
99	;
100	T{ T.CONVERT }T{ 1234 CHAR x }T
101
102	\ ----------------------------------------------------- ERASE
103	: T.COMMA.SEQ ( n -- , lay down N sequential bytes )
104	0 ?DO I C, LOOP
105	;
106	CREATE T-ERASE-DATA 64 T.COMMA.SEQ
107	T{ T-ERASE-DATA 8 + C@ }T{ 8 }T
108	T{ T-ERASE-DATA 7 + 3 ERASE
109	T{ T-ERASE-DATA 6 + C@ }T{ 6 }T
110	T{ T-ERASE-DATA 7 + C@ }T{ 0 }T
111	T{ T-ERASE-DATA 8 + C@ }T{ 0 }T
112	T{ T-ERASE-DATA 9 + C@ }T{ 0 }T
113	T{ T-ERASE-DATA 10 + C@ }T{ 10 }T
114
115	\ ----------------------------------------------------- FALSE
116	T{ FALSE }T{ 0 }T
117
118	\ ----------------------------------------------------- HEX
119	T{ HEX 10 DECIMAL }T{ 16 }T
120
121	\ ----------------------------------------------------- MARKER
122	: INDIC? ( <name> -- ifInDic , is the following word defined? )
123	bl word find
124	swap drop 0= 0=
125	;
126	create FOOBAR
127	MARKER MYMARK \ create word that forgets itself
128	create GOOFBALL
129	MYMARK
130	T{ indic? foobar indic? mymark indic? goofball }T{ true false false }T
131
132	\ ----------------------------------------------------- NIP
133	T{ 33 44 55 NIP }T{ 33 55 }T
134
135	\ ----------------------------------------------------- PARSE
136	: T.PARSE ( char <string>char -- addr num )
137	PARSE
138	>R \ save length
139	PAD R@ CMOVE \ move string to pad
140	PAD R>
141	;
142	T{ CHAR % T.PARSE wxyz% SWAP C@ }T{ 4 CHAR w }T
143
144	\ ----------------------------------------------------- PICK
145	T{ 13 12 11 10 2 PICK }T{ 13 12 11 10 12 }T
146
147	\ ----------------------------------------------------- QUERY
148	T{ ' QUERY 0<> }T{ TRUE }T
149
150	\ ----------------------------------------------------- REFILL
151	T{ ' REFILL 0<> }T{ TRUE }T
152
153	\ ----------------------------------------------------- RESTORE-INPUT
08689895 HE	154	T{ : T.SAVE-INPUT SAVE-INPUT RESTORE-INPUT ; T.SAVE-INPUT }T{ 0 }T
	155
	156	\ TESTING SAVE-INPUT and RESTORE-INPUT with a string source
	157
	158	VARIABLE SI_INC 0 SI_INC !
	159
	160	: SI1
	161	SI_INC @ >IN +!
	162	15 SI_INC !
	163	;
	164
	165	: S$ S" SAVE-INPUT SI1 RESTORE-INPUT 12345" ;
	166
	167	T{ S$ EVALUATE SI_INC @ }T{ 0 2345 15 }T
8e9db35f PB	168
	169	\ ----------------------------------------------------- ROLL
	170	T{ 15 14 13 12 11 10 0 ROLL }T{ 15 14 13 12 11 10 }T
	171	T{ 15 14 13 12 11 10 1 ROLL }T{ 15 14 13 12 10 11 }T
	172	T{ 15 14 13 12 11 10 2 ROLL }T{ 15 14 13 11 10 12 }T
	173	T{ 15 14 13 12 11 10 3 ROLL }T{ 15 14 12 11 10 13 }T
	174	T{ 15 14 13 12 11 10 4 ROLL }T{ 15 13 12 11 10 14 }T
	175
	176	\ ----------------------------------------------------- SOURCE-ID
	177	T{ SOURCE-ID 0<> }T{ TRUE }T
	178	T{ : T.SOURCE-ID S" SOURCE-ID" EVALUATE ; T.SOURCE-ID }T{ -1 }T
	179
	180	\ ----------------------------------------------------- SPAN
	181	T{ ' SPAN 0<> }T{ TRUE }T
	182
	183	\ ----------------------------------------------------- TO VALUE
	184	333 VALUE MY-VALUE
	185	T{ MY-VALUE }T{ 333 }T
	186	T{ 1000 TO MY-VALUE MY-VALUE }T{ 1000 }T
	187	: TEST.VALUE ( -- 19 100 )
	188	100 TO MY-VALUE
	189	19
	190	MY-VALUE
	191	;
	192	T{ TEST.VALUE }T{ 19 100 }T
	193
	194	\ ----------------------------------------------------- TRUE
	195	T{ TRUE }T{ 0 0= }T
	196
	197	\ ----------------------------------------------------- TUCK
	198	T{ 44 55 66 TUCK }T{ 44 66 55 66 }T
	199
	200	\ ----------------------------------------------------- U.R
	201	HEX CR .( ABCD4321 - SHOULD LINE UP WITH NEXT LINE.) CR
	202	ABCD4321 C U.R CR DECIMAL
	203
	204	\ ----------------------------------------------------- U>
	205	T{ -5 3 U> }T{ TRUE }T
	206	T{ 10 8 U> }T{ TRUE }T
	207
	208	\ ----------------------------------------------------- UNUSED
	209	T{ UNUSED 0> }T{ TRUE }T
	210
	211	\ ----------------------------------------------------- WITHIN
	212	T{ 4 5 10 WITHIN }T{ 0 }T
	213	T{ 5 5 10 WITHIN }T{ TRUE }T
	214	T{ 9 5 10 WITHIN }T{ TRUE }T
	215	T{ 10 5 10 WITHIN }T{ 0 }T
	216
	217	T{ 4 10 5 WITHIN }T{ TRUE }T
	218	T{ 5 10 5 WITHIN }T{ 0 }T
	219	T{ 9 10 5 WITHIN }T{ 0 }T
	220	T{ 10 10 5 WITHIN }T{ TRUE }T
	221
	222	T{ -6 -5 10 WITHIN }T{ 0 }T
	223	T{ -5 -5 10 WITHIN }T{ TRUE }T
	224	T{ 9 -5 10 WITHIN }T{ TRUE }T
	225	T{ 10 -5 10 WITHIN }T{ 0 }T
	226
	227
	228	\ ----------------------------------------------------- [COMPILE]
	229	: T.[COMPILE].IF [COMPILE] IF ; IMMEDIATE
	230	: T.[COMPILE] 40 0> T.[COMPILE].IF 97 ELSE 53 THEN 97 = ;
	231	T{ T.[COMPILE] }T{ TRUE }T
232
233	\ ----------------------------------------------------- \
d98c27bb HE	234
	235	\ .( TESTING DO +LOOP with large and small increments )
	236
	237	\ Contributed by Andrew Haley
	238	0 invert CONSTANT MAX-UINT
	239	0 INVERT 1 RSHIFT CONSTANT MAX-INT
	240	0 INVERT 1 RSHIFT INVERT CONSTANT MIN-INT
	241	MAX-UINT 8 RSHIFT 1+ CONSTANT USTEP
	242	USTEP NEGATE CONSTANT -USTEP
	243	MAX-INT 7 RSHIFT 1+ CONSTANT STEP
	244	STEP NEGATE CONSTANT -STEP
	245
	246	VARIABLE BUMP
	247
	248	T{ : GD8 BUMP ! DO 1+ BUMP @ +LOOP ; }T{ }T
	249
	250	T{ 0 MAX-UINT 0 USTEP GD8 }T{ 256 }T
	251	T{ 0 0 MAX-UINT -USTEP GD8 }T{ 256 }T
	252
	253	T{ 0 MAX-INT MIN-INT STEP GD8 }T{ 256 }T
	254	T{ 0 MIN-INT MAX-INT -STEP GD8 }T{ 256 }T
	255
	256	\ Two's complement arithmetic, wraps around modulo wordsize
	257	\ Only tested if the Forth system does wrap around, use of conditional
	258	\ compilation deliberately avoided
	259
	260	MAX-INT 1+ MIN-INT = CONSTANT +WRAP?
	261	MIN-INT 1- MAX-INT = CONSTANT -WRAP?
	262	MAX-UINT 1+ 0= CONSTANT +UWRAP?
	263	0 1- MAX-UINT = CONSTANT -UWRAP?
	264
	265	: GD9 ( n limit start step f result -- )
	266	>R IF GD8 ELSE 2DROP 2DROP R@ THEN }T{ R> }T
	267	;
	268
	269	T{ 0 0 0 USTEP +UWRAP? 256 GD9
	270	T{ 0 0 0 -USTEP -UWRAP? 1 GD9
	271	T{ 0 MIN-INT MAX-INT STEP +WRAP? 1 GD9
	272	T{ 0 MAX-INT MIN-INT -STEP -WRAP? 1 GD9
	273
	274	\ --------------------------------------------------------------------------
	275	\ .( TESTING DO +LOOP with maximum and minimum increments )
	276
	277	: (-MI) MAX-INT DUP NEGATE + 0= IF MAX-INT NEGATE ELSE -32767 THEN ;
	278	(-MI) CONSTANT -MAX-INT
	279
	280	T{ 0 1 0 MAX-INT GD8 }T{ 1 }T
	281	T{ 0 -MAX-INT NEGATE -MAX-INT OVER GD8 }T{ 2 }T
	282
	283	T{ 0 MAX-INT 0 MAX-INT GD8 }T{ 1 }T
	284	T{ 0 MAX-INT 1 MAX-INT GD8 }T{ 1 }T
	285	T{ 0 MAX-INT -1 MAX-INT GD8 }T{ 2 }T
	286	T{ 0 MAX-INT DUP 1- MAX-INT GD8 }T{ 1 }T
	287
	288	T{ 0 MIN-INT 1+ 0 MIN-INT GD8 }T{ 1 }T
	289	T{ 0 MIN-INT 1+ -1 MIN-INT GD8 }T{ 1 }T
	290	T{ 0 MIN-INT 1+ 1 MIN-INT GD8 }T{ 2 }T
	291	T{ 0 MIN-INT 1+ DUP MIN-INT GD8 }T{ 1 }T
	292
40c6f87f HE	293	\ ----------------------------------------------------------------------------
	294	\ .( TESTING number prefixes # $ % and 'c' character input )
	295	\ Adapted from the Forth 200X Draft 14.5 document
	296
	297	VARIABLE OLD-BASE
	298	DECIMAL BASE @ OLD-BASE !
	299	T{ #1289 }T{ 1289 }T
	300	T{ #-1289 }T{ -1289 }T
	301	T{ $12eF }T{ 4847 }T
	302	T{ $-12eF }T{ -4847 }T
	303	T{ %10010110 }T{ 150 }T
	304	T{ %-10010110 }T{ -150 }T
	305	T{ 'z' }T{ 122 }T
	306	T{ 'Z' }T{ 90 }T
	307	\ Check BASE is unchanged
	308	T{ BASE @ OLD-BASE @ = }T{ TRUE }T
	309
	310	\ Repeat in Hex mode
	311	16 OLD-BASE ! 16 BASE !
	312	T{ #1289 }T{ 509 }T
	313	T{ #-1289 }T{ -509 }T
	314	T{ $12eF }T{ 12EF }T
	315	T{ $-12eF }T{ -12EF }T
	316	T{ %10010110 }T{ 96 }T
	317	T{ %-10010110 }T{ -96 }T
	318	T{ 'z' }T{ 7a }T
	319	T{ 'Z' }T{ 5a }T
	320	\ Check BASE is unchanged
	321	T{ BASE @ OLD-BASE @ = }T{ TRUE }T \ 2
	322
	323	DECIMAL
	324	\ Check number prefixes in compile mode
	325	T{ : nmp #8327 $-2cbe %011010111 ''' ; nmp }T{ 8327 -11454 215 39 }T
d98c27bb	326
29bf5876 HE	327	\ ----------------------------------------------------- ENVIRONMENT?
	328
	329	T{ s" unknown-query-string" ENVIRONMENT? }T{ FALSE }T
	330	T{ s" MAX-CHAR" ENVIRONMENT? }T{ 255 TRUE }T
	331	T{ s" ADDRESS-UNITS-BITS" ENVIRONMENT? }T{ 8 TRUE }T
	332
8e9db35f PB	333	}TEST
8e9db35f PB	334