Skip to content

Commit

Permalink
Implement ENVIRONMENT?
Browse files Browse the repository at this point in the history
* fth/misc2.fth (ENVIRONMENT?): New.
(env=, 2env=, max-u, max-n): New helpers.

* fth/t_corex.fth: Add basic tests for ENVIRONMENT?.
  • Loading branch information
ellerh committed Dec 25, 2016
1 parent 3678daa commit 29bf587
Show file tree
Hide file tree
Showing 2 changed files with 38 additions and 0 deletions.
32 changes: 32 additions & 0 deletions fth/misc2.fth
Original file line number Diff line number Diff line change
Expand Up @@ -233,3 +233,35 @@ VARIABLE SPAN
addr3 cnt3 flag
;

private{

: env= ( c-addr u c-addr1 u1 x -- x true true | c-addr u false )
{ x } 2over compare 0= if 2drop x true true else false then
;

: 2env= ( c-addr u c-addr1 u1 x y -- x y true true | c-addr u false )
{ x y } 2over compare 0= if 2drop x y true true else false then
;

0 invert constant max-u
0 invert 1 rshift constant max-n

}private

: ENVIRONMENT? ( c-addr u -- false | i*x true )
s" /COUNTED-STRING" 255 env= if exit then
s" /HOLD" 128 env= if exit then \ same as PAD
s" /PAD" 128 env= if exit then
s" ADDRESS-UNITS-BITS" 8 env= if exit then
s" FLOORED" false env= if exit then
s" MAX-CHAR" 255 env= if exit then
s" MAX-D" max-n max-u 2env= if exit then
s" MAX-N" max-n env= if exit then
s" MAX-U" max-u env= if exit then
s" MAX-UD" max-u max-u 2env= if exit then
s" RETURN-STACK-CELLS" 512 env= if exit then \ DEFAULT_RETURN_DEPTH
s" STACK-CELLS" 512 env= if exit then \ DEFAULT_USER_DEPTH
2drop false
;

privatize
6 changes: 6 additions & 0 deletions fth/t_corex.fth
Original file line number Diff line number Diff line change
Expand Up @@ -315,5 +315,11 @@ 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

0 comments on commit 29bf587

Please sign in to comment.