false CONSTANT true CONSTANT testing 7.3.3.1 Memory access \ the words are tested somewhat out of order from how they \ appear in IEEE 1275-1994 7.3.3.1 \ not tested yet: COMP, WBFLIPS, LBFLIPS, LWFLIPS HERE 1 , HERE 2 , CONSTANT 2ND CONSTANT 1ST T{ 1ST 2ND U< -> }T \ HERE MUST GROW WITH ALLOT T{ 1ST CELL+ -> 2ND }T \ ... BY ONE CELL T{ 1ST 1 CELLS + -> 2ND }T T{ 1ST @ 2ND @ -> 1 2 }T T{ 5 1ST ! -> }T T{ 1ST @ 2ND @ -> 5 2 }T T{ 6 2ND ! -> }T T{ 1ST @ 2ND @ -> 5 6 }T T{ 1ST 2@ -> 6 5 }T T{ 2 1 1ST 2! -> }T T{ 1ST 2@ -> 2 1 }T T{ 1S 1ST ! 1ST @ -> 1S }T \ CAN STORE CELL-WIDE VALUE t{ 1st off -> }t t{ 1st @ -> }t t{ 1st on -> }t t{ 1st @ -> }t HERE 1 C, HERE 2 C, CONSTANT 2NDC CONSTANT 1STC T{ 1STC 2NDC U< -> }T \ HERE MUST GROW WITH ALLOT T{ 1STC CHAR+ -> 2NDC }T \ ... BY ONE CHAR T{ 1STC 1 CHARS + -> 2NDC }T T{ 1STC C@ 2NDC C@ -> 1 2 }T T{ 3 1STC C! -> }T T{ 1STC C@ 2NDC C@ -> 3 2 }T T{ 4 2NDC C! -> }T T{ 1STC C@ 2NDC C@ -> 3 4 }T HERE 1 w, HERE 2 w, CONSTANT 2NDw CONSTANT 1STw T{ 1STw 2NDw U< -> }T \ HERE MUST GROW WITH ALLOT T{ 1STw wa1+ -> 2NDw }T \ ... BY ONE CHAR T{ 1STw 1 /w* + -> 2NDw }T T{ 1STw w@ 2NDw w@ -> 1 2 }T T{ 3 1STw w! -> }T T{ 1STw w@ 2NDw w@ -> 3 2 }T T{ 4 2NDw w! -> }T T{ 1STw w@ 2NDw w@ -> 3 4 }T \ test sign extension of }t t{ 1stw -1 }t HERE 1 l, HERE 2 l, CONSTANT 2NDl CONSTANT 1STl T{ 1STl 2NDl U< -> }T \ HERE MUST GROW WITH ALLOT T{ 1STl la1+ -> 2NDl }T \ ... BY ONE CHAR T{ 1STl 1 /l* + -> 2NDl }T T{ 1STl l@ 2NDl l@ -> 1 2 }T T{ 3 1STl l! -> }T T{ 1STl w@ 2NDl l@ -> 3 2 }T T{ 4 2NDl l! -> }T T{ 1STl w@ 2NDl l@ -> 3 4 }T ALIGN 1 ALLOT HERE ALIGN HERE 3 CELLS ALLOT CONSTANT A-ADDR CONSTANT UA-ADDR T{ UA-ADDR ALIGNED -> A-ADDR }T T{ 1 A-ADDR C! A-ADDR C@ -> 1 }T T{ 1234 A-ADDR ! A-ADDR @ -> 1234 }T T{ 123 456 A-ADDR 2! A-ADDR 2@ -> 123 456 }T T{ 2 A-ADDR CHAR+ C! A-ADDR CHAR+ C@ -> 2 }T T{ 3 A-ADDR CELL+ C! A-ADDR CELL+ C@ -> 3 }T T{ 1234 A-ADDR CELL+ ! A-ADDR CELL+ @ -> 1234 }T T{ 123 456 A-ADDR CELL+ 2! A-ADDR CELL+ 2@ -> 123 456 }T T{ 0 1ST ! -> }T T{ 1 1ST +! -> }T T{ 1ST @ -> 1 }T T{ -1 1ST +! 1ST @ -> 0 }T CREATE FBUF 00 C, 00 C, 00 C, CREATE SBUF 12 C, 34 C, 56 C, : SEEBUF FBUF C@ FBUF CHAR+ C@ FBUF CHAR+ CHAR+ C@ ; T{ FBUF 0 20 FILL -> }T T{ SEEBUF -> 00 00 00 }T T{ FBUF 1 20 FILL -> }T T{ SEEBUF -> 20 00 00 }T T{ FBUF 3 20 FILL -> }T T{ SEEBUF -> 20 20 20 }T T{ FBUF FBUF 3 CHARS MOVE -> }T \ BIZARRE SPECIAL CASE T{ SEEBUF -> 20 20 20 }T T{ SBUF FBUF 0 CHARS MOVE -> }T T{ SEEBUF -> 20 20 20 }T T{ SBUF FBUF 1 CHARS MOVE -> }T T{ SEEBUF -> 12 20 20 }T T{ SBUF FBUF 3 CHARS MOVE -> }T T{ SEEBUF -> 12 34 56 }T T{ FBUF FBUF CHAR+ 2 CHARS MOVE -> }T T{ SEEBUF -> 12 12 34 }T T{ FBUF CHAR+ FBUF 2 CHARS MOVE -> }T T{ SEEBUF -> 12 34 34 }T 84 CONSTANT CHARS/PAD \ Minimum size of PAD in chars CHARS/PAD CHARS CONSTANT AUS/PAD : CHECKPAD ( caddr u ch -- f ) \ f = TRUE if u chars = ch SWAP 0 ?DO OVER I CHARS + C@ OVER <> IF 2DROP UNLOOP FALSE EXIT THEN LOOP 2DROP TRUE ; T{ PAD DROP -> }T T{ 0 INVERT PAD C! -> }T T{ PAD C@ CONSTANT MAXCHAR -> }T T{ PAD CHARS/PAD 2DUP MAXCHAR FILL MAXCHAR CHECKPAD -> TRUE }T T{ PAD CHARS/PAD 2DUP CHARS ERASE 0 CHECKPAD -> TRUE }T T{ PAD CHARS/PAD 2DUP MAXCHAR FILL PAD 0 ERASE MAXCHAR CHECKPAD -> TRUE }T T{ PAD 43 CHARS + 9 CHARS ERASE -> }T T{ PAD 43 MAXCHAR CHECKPAD -> TRUE }T T{ PAD 43 CHARS + 9 0 CHECKPAD -> TRUE }T T{ PAD 52 CHARS + CHARS/PAD 52 - MAXCHAR CHECKPAD -> TRUE }T t{ pad chars/pad 2dup blank bl checkpad -> true }t \ Check that use of WORD and pictured numeric output do not corrupt PAD \ Minimum size of buffers for these are 33 chars and (2*n)+2 chars respectively \ where n is number of bits per cell PAD CHARS/PAD ERASE 2 BASE ! MAX-UINT MAX-UINT <# #S CHAR 1 DUP HOLD HOLD #> 2DROP DECIMAL BL WORD 12345678123456781234567812345678 DROP T{ PAD CHARS/PAD 0 CHECKPAD -> TRUE }T \ this test bites, need to improve testing tool to allow \ multi-line expectations variable dumptst t{ dumptst 4 dump -> }t \ expect: "" \ These aren't tested and are optional aliases, anyway \ this cheats the tests to make them covered :-) t{ parse-word unaligned-l@ $find if else drop then drop -> }t t{ parse-word unaligned-l! $find if else drop then drop -> }t t{ parse-word unaligned-w@ $find if else drop then drop -> }t t{ parse-word unaligned-w! $find if else drop then drop -> }t testing 7.3.3.2 Memory allocation \ todo: adapt alloc/free tests t{ 100 alloc-mem debug-mem 100 free-mem -> }t