mirror of
https://github.com/mgcaret/of816.git
synced 2024-11-15 17:09:15 +00:00
156 lines
3.4 KiB
Forth
156 lines
3.4 KiB
Forth
testing 7.3.9.1 Defining words
|
|
|
|
T{ 123 CONSTANT X123 -> }T
|
|
T{ X123 -> 123 }T
|
|
T{ : EQU CONSTANT ; -> }T
|
|
T{ X123 EQU Y123 -> }T
|
|
T{ Y123 -> 123 }T
|
|
|
|
\ todo: 2constant
|
|
|
|
T{ 111 VALUE VAL1 -999 VALUE VAL2 -> }T
|
|
T{ VAL1 -> 111 }T
|
|
T{ VAL2 -> -999 }T
|
|
T{ 222 TO VAL1 -> }T
|
|
T{ VAL1 -> 222 }T
|
|
T{ : VD1 VAL1 ; -> }T
|
|
T{ VD1 -> 222 }T
|
|
T{ : VD2 TO VAL2 ; -> }T
|
|
T{ VAL2 -> -999 }T
|
|
T{ -333 VD2 -> }T
|
|
T{ VAL2 -> -333 }T
|
|
T{ VAL1 -> 222 }T
|
|
T{ 123 VALUE VAL3 IMMEDIATE VAL3 -> 123 }T
|
|
T{ : VD3 VAL3 LITERAL ; VD3 -> 123 }T
|
|
|
|
T{ VARIABLE V1 -> }T
|
|
T{ 123 V1 ! -> }T
|
|
T{ V1 @ -> 123 }T
|
|
|
|
T{ 8 BUFFER: BUF:TEST -> }T
|
|
T{ BUF:TEST DUP ALIGNED = -> TRUE }T
|
|
T{ 111 BUF:TEST ! 222 BUF:TEST CELL+ ! -> }T
|
|
T{ BUF:TEST @ BUF:TEST CELL+ @ -> 111 222 }T
|
|
|
|
\ todo: alias
|
|
|
|
t{ defer df1 -> }t
|
|
t{ ' true to df1 -> }t
|
|
t{ ' df1 behavior -> ' true }t
|
|
t{ df1 -> true }t
|
|
t{ ' false to df1 -> }t
|
|
t{ ' df1 behavior -> ' false }t
|
|
t{ df1 -> false }t
|
|
|
|
\ todo: struct field
|
|
|
|
T{ : NOP : POSTPONE ; ; -> }T
|
|
T{ NOP NOP1 NOP NOP2 -> }T
|
|
T{ NOP1 -> }T
|
|
T{ NOP2 -> }T
|
|
|
|
T{ : DOES1 DOES> @ 1 + ; -> }T
|
|
T{ : DOES2 DOES> @ 2 + ; -> }T
|
|
T{ CREATE CR1 -> }T
|
|
T{ CR1 -> HERE }T
|
|
T{ ' CR1 >BODY -> HERE }T
|
|
T{ 1 , -> }T
|
|
T{ CR1 @ -> 1 }T
|
|
T{ DOES1 -> }T
|
|
T{ CR1 -> 2 }T
|
|
T{ DOES2 -> }T
|
|
T{ CR1 -> 3 }T
|
|
|
|
T{ : WEIRD: CREATE DOES> 1 + DOES> 2 + ; -> }T
|
|
T{ WEIRD: W1 -> }T
|
|
T{ ' W1 >BODY -> HERE }T
|
|
T{ W1 -> HERE 1 + }T
|
|
T{ W1 -> HERE 2 + }T
|
|
|
|
\ todo: $create (but if CREATE works, $CREATE does as well)
|
|
|
|
: forgetme1 ;
|
|
: forgetme2 ;
|
|
: forgetme3 ;
|
|
t{ forget forgetme3 s" forgetme3" $find nip nip -> 0 }t
|
|
t{ forget forgetme1 s" forgetme2" $find nip nip s" forgetme1" $find nip nip -> 0 0 }t
|
|
|
|
testing 7.3.9.2 Dictionary commands
|
|
|
|
testing 7.3.9.2.1 Data space allocation
|
|
|
|
\ tested in 7.3.3: here allot align c, w, l, ,
|
|
|
|
testing 7.3.9.2.2 Immediate words
|
|
|
|
T{ : GT1 123 ; -> }T
|
|
T{ ' GT1 EXECUTE -> 123 }T
|
|
T{ : GT2 ['] GT1 ; IMMEDIATE -> }T
|
|
T{ GT2 EXECUTE -> 123 }T
|
|
HERE 3 C, CHAR G C, CHAR T C, CHAR 1 C, CONSTANT GT1STRING
|
|
HERE 3 C, CHAR G C, CHAR T C, CHAR 2 C, CONSTANT GT2STRING
|
|
T{ GT1STRING FIND -> ' GT1 -1 }T
|
|
T{ GT2STRING FIND -> ' GT2 1 }T
|
|
( HOW TO SEARCH FOR NON-EXISTENT WORD? )
|
|
T{ : GT3 GT2 LITERAL ; -> }T
|
|
T{ GT3 -> ' GT1 }T
|
|
T{ GT1STRING COUNT -> GT1STRING CHAR+ 3 }T
|
|
|
|
T{ : GT4 POSTPONE GT1 ; IMMEDIATE -> }T
|
|
T{ : GT5 GT4 ; -> }T
|
|
T{ GT5 -> 123 }T
|
|
T{ : GT6 345 ; IMMEDIATE -> }T
|
|
T{ : GT7 POSTPONE GT6 ; -> }T
|
|
T{ GT7 -> 345 }T
|
|
|
|
T{ : GT8 STATE @ ; IMMEDIATE -> }T
|
|
T{ GT8 -> 0 }T
|
|
T{ : GT9 GT8 LITERAL ; -> }T
|
|
T{ GT9 0= -> false }T
|
|
|
|
variable csr
|
|
1 csr !
|
|
t{ : cst [ state @ csr ! ] ; -> }t
|
|
t{ csr @ -> 0 }t
|
|
|
|
\ todo: compile [compile] compile,
|
|
|
|
testing 7.3.9.2.3 Dictionary search
|
|
|
|
variable wxt
|
|
t{ : wxtt ['] find wxt ! ; -> }t
|
|
t{ wxtt wxt @ -> ' find }t
|
|
t{ bl word find find -> ' find -1 }t \ found
|
|
t{ bl word postpone find -> ' postpone 1 }t \ found immediate
|
|
t{ bl word supercalafrag find nip -> 0 }t \ not found
|
|
|
|
testing 7.3.9.2.4 Miscellaneous dictionary
|
|
|
|
\ to and behavior for defer tested above
|
|
\ to for value tested above
|
|
\ >body tested above
|
|
|
|
create bd1
|
|
t{ ' bd1 >body body> -> ' bd1 }t
|
|
|
|
variable rrv1
|
|
t{ : rr1 recursive [ bl word rr1 find drop rrv1 ! ] ; -> }t
|
|
t{ rrv1 @ -> ' rr1 }t
|
|
t{ : rr2 [ bl word rr2 find nip rrv1 ! ] ; -> }t
|
|
t{ rrv1 @ -> 0 }t
|
|
|
|
\ recurse tested in 7.3.8
|
|
|
|
\ existence checks only (todo)
|
|
t{ ' forth 0= -> false }t
|
|
t{ ' environment? 0= -> false }t
|
|
|
|
testing 7.3.9.2.4 Assembler
|
|
|
|
\ existence checks only (todo)
|
|
t{ ' code 0= -> false }t
|
|
t{ ' label 0= -> false }t
|
|
t{ ' c; 0= -> false }t
|
|
t{ ' end-code 0= -> false }t
|
|
|