From 2a0eccda84f6f59b9f88b9d4901f17c6c7b7814a Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Sun, 1 May 2016 10:29:49 +1200 Subject: [PATCH] TICK problem solved. (Split into ['] and '.) Follows forth 83 standard. --- examples/mandelbrot.4th | 14 ++++-- src/forth.jl | 8 ++-- src/lib.4th | 104 ++++++++++++++++++++-------------------- 3 files changed, 64 insertions(+), 62 deletions(-) diff --git a/examples/mandelbrot.4th b/examples/mandelbrot.4th index b8195f4..1fc6f16 100644 --- a/examples/mandelbrot.4th +++ b/examples/mandelbrot.4th @@ -73,12 +73,8 @@ 100 value xsteps 30 value ysteps -: mandelDomain - -2 0 >scaled -1 0 >scaled 0 5 >scaled 1 0 >scaled -; - ( Draw the Mandelbrot Set!) -: mandelDraw ( x1 y1 x2 y2 -- ) +: mandeldraw ( x1 y1 x2 y2 -- ) 0 pick 3 pick - ysteps / 1 pick 4 pick do @@ -103,3 +99,11 @@ ( Clean up - hide non-standard multiplication def. ) hide * + +( Default picture ) +: mandel + -2 0 >scaled -1 0 >scaled 0 5 >scaled 1 0 >scaled + mandeldraw +; + +." Enter 'mandel' to draw the Mandelbrot Set." diff --git a/src/forth.jl b/src/forth.jl index df86674..6578d75 100644 --- a/src/forth.jl +++ b/src/forth.jl @@ -822,12 +822,10 @@ IMMEDIATE = defPrimWord("IMMEDIATE", () -> begin return NEXT end, flags=F_IMMED) -#TICK = defWord("'", -# [STATE_CFA, FETCH, ZBRANCH, 7, -# FROMR, DUP, INCR, TOR, FETCH, EXIT, -# WORD, FIND, TOCFA, EXIT]) - TICK = defWord("'", + [WORD, FIND, TOCFA, EXIT]) + +BTICK = defWord("[']", [FROMR, DUP, INCR, TOR, FETCH, EXIT]) diff --git a/src/lib.4th b/src/lib.4th index eae7a5d..22b7884 100644 --- a/src/lib.4th +++ b/src/lib.4th @@ -15,7 +15,7 @@ : '\n' 10 ; : BL 32 ; -: LITERAL IMMEDIATE ' LIT , , ; +: LITERAL IMMEDIATE ['] LIT , , ; : ':' [ CHAR : ] LITERAL ; : ';' [ CHAR ; ] LITERAL ; @@ -51,7 +51,7 @@ \ CONTROL STRUCTURES ---------------------------------------------------------------------- : IF IMMEDIATE - ' 0BRANCH , \ compile 0BRANCH + ['] 0BRANCH , \ compile 0BRANCH HERE @ \ save location of the offset on the stack 0 , \ compile a dummy offset ; @@ -63,7 +63,7 @@ ; : ELSE IMMEDIATE - ' BRANCH , \ definite branch to just over the false-part + ['] BRANCH , \ definite branch to just over the false-part HERE @ \ save location of the offset on the stack 0 , \ compile a dummy offset SWAP \ now back-fill the original (IF) offset @@ -77,25 +77,25 @@ ; : UNTIL IMMEDIATE - ' 0BRANCH , \ compile 0BRANCH + ['] 0BRANCH , \ compile 0BRANCH HERE @ - \ calculate the offset from the address saved on the stack , \ compile the offset here ; : AGAIN IMMEDIATE - ' BRANCH , \ compile BRANCH + ['] BRANCH , \ compile BRANCH HERE @ - \ calculate the offset back , \ compile the offset here ; : WHILE IMMEDIATE - ' 0BRANCH , \ compile 0BRANCH + ['] 0BRANCH , \ compile 0BRANCH HERE @ \ save location of the offset2 on the stack 0 , \ compile a dummy offset2 ; : REPEAT IMMEDIATE - ' BRANCH , \ compile BRANCH + ['] BRANCH , \ compile BRANCH SWAP \ get the original offset (from BEGIN) HERE @ - , \ and compile it after BRANCH DUP @@ -104,21 +104,21 @@ ; : UNLESS IMMEDIATE - ' NOT , \ compile NOT (to reverse the test) + ['] NOT , \ compile NOT (to reverse the test) [COMPILE] IF \ continue by calling the normal IF ; : DO IMMEDIATE - ' LIT , -1 , [COMPILE] IF - ' >R , ' >R , - ' LIT , HERE @ 0 , ' >R , + ['] LIT , -1 , [COMPILE] IF + ['] >R , ['] >R , + ['] LIT , HERE @ 0 , ['] >R , HERE @ ; : ?DO IMMEDIATE - ' 2DUP , ' - , [COMPILE] IF - ' >R , ' >R , - ' LIT , HERE @ 0 , ' >R , + ['] 2DUP , ['] - , [COMPILE] IF + ['] >R , ['] >R , + ['] LIT , HERE @ 0 , ['] >R , HERE @ ; @@ -127,47 +127,47 @@ : J RSP@ 6 - @ ; : ?LEAVE IMMEDIATE - ' 0BRANCH , 13 , - ' R> , ' RDROP , ' RDROP , - ' LIT , HERE @ 7 + , ' DUP , ' -ROT , ' - , ' SWAP , ' ! , - ' BRANCH , + ['] 0BRANCH , 13 , + ['] R> , ['] RDROP , ['] RDROP , + ['] LIT , HERE @ 7 + , ['] DUP , ['] -ROT , ['] - , ['] SWAP , ['] ! , + ['] BRANCH , 0 , ; : LEAVE IMMEDIATE - ' LIT , -1 , + ['] LIT , -1 , [COMPILE] ?LEAVE ; : +LOOP IMMEDIATE - ' DUP , \ Store copy of increment + ['] DUP , \ Store copy of increment - ' R> , ' SWAP , ' R> , ' SWAP , ' R> , ' SWAP , ' + , ' 2DUP , ' - , - ' SWAP , ' >R , ' SWAP , ' >R , ' SWAP , ' >R , + ['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] + , ['] 2DUP , ['] - , + ['] SWAP , ['] >R , ['] SWAP , ['] >R , ['] SWAP , ['] >R , \ Condition differently depending on sign of increment - ' SWAP , ' 0>= , [COMPILE] IF - ' 0<= , + ['] SWAP , ['] 0>= , [COMPILE] IF + ['] 0<= , [COMPILE] ELSE - ' 0> , + ['] 0> , [COMPILE] THEN \ Branch back to begining of loop kernel - ' 0BRANCH , HERE @ - , + ['] 0BRANCH , HERE @ - , \ Clean up - ' RDROP , ' RDROP , ' RDROP , + ['] RDROP , ['] RDROP , ['] RDROP , \ Record address of loop end for any LEAVEs to use HERE @ SWAP ! [COMPILE] ELSE - ' 2DROP , \ Clean up if loop was entirely skipped (?DO) + ['] 2DROP , \ Clean up if loop was entirely skipped (?DO) [COMPILE] THEN ; : LOOP IMMEDIATE - ' LIT , 1 , + ['] LIT , 1 , [COMPILE] +LOOP ; @@ -386,7 +386,7 @@ : S" IMMEDIATE ( -- addr len ) STATE @ IF ( compiling? ) - ' LITSTRING , ( compile LITSTRING ) + ['] LITSTRING , ( compile LITSTRING ) HERE @ ( save the address of the length word on the stack ) 0 , ( dummy length - we don't know what it is yet ) KEY DROP @@ -421,7 +421,7 @@ : ." IMMEDIATE ( -- ) STATE @ IF ( compiling? ) [COMPILE] S" ( read the string, and compile LITSTRING, etc. ) - ' TELL , ( compile the final TELL ) + ['] TELL , ( compile the final TELL ) ELSE ( In immediate mode, just read characters and print them until we get to the ending double quote. ) @@ -443,9 +443,9 @@ WORD ( get the name (the name follows CONSTANT) ) CREATE ( make the dictionary entry ) DOCOL , ( append DOCOL (the codeword field of this word) ) - ' LIT , ( append the codeword LIT ) -\ , ( append the value on the top of the stack ) - ' EXIT , ( append the codeword EXIT ) + ['] LIT , ( append the codeword LIT ) + , ( append the value on the top of the stack ) + ['] EXIT , ( append the codeword EXIT ) ; : ALLOT ( n -- addr ) @@ -457,18 +457,18 @@ 1 CELLS ALLOT ( allocate 1 cell of memory, push the pointer to this memory ) WORD CREATE ( make the dictionary entry (the name follows VARIABLE) ) DOCOL , ( append DOCOL (the codeword field of this word) ) - ' LIT , ( append the codeword LIT ) + ['] LIT , ( append the codeword LIT ) , ( append the pointer to the new memory ) - ' EXIT , ( append the codeword EXIT ) + ['] EXIT , ( append the codeword EXIT ) ; : VALUE ( n -- ) WORD CREATE ( make the dictionary entry (the name follows VALUE) ) DOCOL , ( append DOCOL ) - ' LIT , ( append the codeword LIT ) + ['] LIT , ( append the codeword LIT ) , ( append the initial value ) - ' EXIT , ( append the codeword EXIT ) + ['] EXIT , ( append the codeword EXIT ) ; : TO IMMEDIATE ( n -- ) @@ -477,9 +477,9 @@ >DFA ( get a pointer to the first data field (the 'LIT') ) 1+ ( increment to point at the value ) STATE @ IF ( compiling? ) - ' LIT , ( compile LIT ) + ['] LIT , ( compile LIT ) , ( compile the address of the value ) - ' ! , ( compile ! ) + ['] ! , ( compile ! ) ELSE ( immediate mode ) ! ( update it straightaway ) THEN @@ -492,9 +492,9 @@ >DFA ( get a pointer to the first data field (the 'LIT') ) 1+ ( increment to point at the value ) STATE @ IF ( compiling? ) - ' LIT , ( compile LIT ) + ['] LIT , ( compile LIT ) , ( compile the address of the value ) - ' +! , ( compile +! ) + ['] +! , ( compile +! ) ELSE ( immediate mode ) +! ( update it straightaway ) THEN @@ -563,10 +563,10 @@ ; : OF IMMEDIATE - ' OVER , ( compile OVER ) - ' = , ( compile = ) + ['] OVER , ( compile OVER ) + ['] = , ( compile = ) [COMPILE] IF ( compile IF ) - ' DROP , ( compile DROP ) + ['] DROP , ( compile DROP ) ; : ENDOF IMMEDIATE @@ -574,7 +574,7 @@ ; : ENDCASE IMMEDIATE - ' DROP , ( compile DROP ) + ['] DROP , ( compile DROP ) ( keep compiling THEN until we get to our zero marker ) BEGIN @@ -635,11 +635,11 @@ DUP @ ( end start codeword ) CASE - ' LIT OF ( is it LIT ? ) + ['] LIT OF ( is it LIT ? ) 1+ DUP @ ( get next word which is the integer constant ) . ( and print it ) ENDOF - ' LITSTRING OF ( is it LITSTRING ? ) + ['] LITSTRING OF ( is it LITSTRING ? ) [ CHAR S ] LITERAL EMIT '"' EMIT SPACE ( print S" ) 1+ DUP @ ( get the length word ) SWAP 1+ SWAP ( end start+1 length ) @@ -648,25 +648,25 @@ + ( end start+1+len, aligned ) 1- ( because we're about to add 4 below ) ENDOF - ' 0BRANCH OF ( is it 0BRANCH ? ) + ['] 0BRANCH OF ( is it 0BRANCH ? ) ." 0BRANCH ( " 1+ DUP @ ( print the offset ) . ." ) " ENDOF - ' BRANCH OF ( is it BRANCH ? ) + ['] BRANCH OF ( is it BRANCH ? ) ." BRANCH ( " 1+ DUP @ ( print the offset ) . ." ) " ENDOF - ' ' OF ( is it ' (TICK) ? ) + ['] ['] OF ( is it ['] ? ) [ CHAR ' ] LITERAL EMIT SPACE 1+ DUP @ ( get the next codeword ) CFA> ( and force it to be printed as a dictionary entry ) ID. SPACE ENDOF - ' EXIT OF ( is it EXIT? ) + ['] EXIT OF ( is it EXIT? ) ( We expect the last word to be EXIT, and if it is then we don't print it because EXIT is normally implied by ;. EXIT can also appear in the middle of words, and then it needs to be printed. ) -- 2.20.1