From: Tim Vaughan Date: Wed, 25 May 2016 12:34:43 +0000 (+1200) Subject: FIND behaviour now standard. Closes #5. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=forth.jl.git;a=commitdiff_plain;h=ef461e2e2bd3226ba279ff37e17ffecfd1c916d1 FIND behaviour now standard. Closes #5. To accomplish this it was necessary to include a marker bit in the NFA ot allow for implementation of >LFA and >NAME required for decompilation. --- diff --git a/src/forth.jl b/src/forth.jl index 5956a0d..6436f79 100644 --- a/src/forth.jl +++ b/src/forth.jl @@ -131,16 +131,17 @@ getPrimName(addr::Int64) = primNames[-addr] # Word creation functions -F_IMMED = 128 -F_HIDDEN = 256 -F_LENMASK = 127 +F_LENMASK = 31 +F_IMMED = 32 +F_HIDDEN = 64 +NFA_MARK = 128 function createHeader(name::AbstractString, flags::Int64) mem[mem[H]] = mem[LATEST] mem[LATEST] = mem[H] mem[H] += 1 - mem[mem[H]] = length(name) | flags; mem[H] += 1 + mem[mem[H]] = length(name) | flags | NFA_MARK; mem[H] += 1 putString(name, mem[H]); mem[H] += length(name) end @@ -249,6 +250,7 @@ defConst("MEMSIZE", size_mem) F_IMMED_CFA = defConst("F_IMMED", F_IMMED) F_HIDDEN_CFA = defConst("F_HIDDEN", F_HIDDEN) F_LENMASK_CFA = defConst("F_LENMASK", F_LENMASK) +NFA_MARK_CFA = defConst("NFA_MARK", NFA_MARK) # Basic forth primitives @@ -670,6 +672,7 @@ FIND = defPrimWord("FIND", () -> begin word = lowercase(getString(wordAddr, wordLen)) latest = LATEST + lenAndFlags = 0 i = 0 while (latest = mem[latest]) > 0 @@ -702,7 +705,6 @@ FIND = defPrimWord("FIND", () -> begin pushPS(0) end - return NEXT end) @@ -852,30 +854,30 @@ INTERPRET = defWord("INTERPRET", DUP, FETCH, ZE, ZBRANCH, 3, DROP, EXIT, # Exit if TIB is exhausted - STATE_CFA, FETCH, ZBRANCH, 31, + STATE_CFA, FETCH, ZBRANCH, 24, # Compiling - DUP, FIND, QDUP, ZBRANCH, 19, + FIND, QDUP, ZBRANCH, 13, # Found word. - SWAP, DROP, - DUP, TOCFA, SWAP, INCR, FETCH, LIT, F_IMMED, AND, ZBRANCH, 4, + LIT, -1, EQ, INVERT, ZBRANCH, 4, + # Immediate: Execute! - EXECUTE, BRANCH, -33, + EXECUTE, BRANCH, -26, # Not immediate: Compile! - COMMA, BRANCH, -36, + COMMA, BRANCH, -29, # No word found, parse number - NUMBER, BTICK, LIT, COMMA, COMMA, BRANCH, -43, + NUMBER, BTICK, LIT, COMMA, COMMA, BRANCH, -36, # Interpreting - DUP, FIND, QDUP, ZBRANCH, 7, + FIND, QDUP, ZBRANCH, 5, # Found word. Execute! - SWAP, DROP, TOCFA, EXECUTE, BRANCH, -54, + DROP, EXECUTE, BRANCH, -44, # No word found, parse number and leave on stack - NUMBER, BRANCH, -57, + NUMBER, BRANCH, -47, EXIT] ) @@ -972,28 +974,22 @@ RBRAC = defPrimWord("]", () -> begin end, flags=F_IMMED) HIDDEN = defPrimWord("HIDDEN", () -> begin - addr = popPS() + 1 - mem[addr] = mem[addr] $ F_HIDDEN + lenAndFlagsAddr = mem[LATEST] + 1 + mem[lenAndFlagsAddr] = mem[lenAndFlagsAddr] $ F_HIDDEN return NEXT end) -HIDE = defWord("HIDE", - [LIT, 32, WORD, - FIND, - HIDDEN, - EXIT]) - COLON = defWord(":", [LIT, 32, WORD, HEADER, LIT, DOCOL, COMMA, - LATEST_CFA, FETCH, HIDDEN, + HIDDEN, RBRAC, EXIT]) SEMICOLON = defWord(";", [LIT, EXIT, COMMA, - LATEST_CFA, FETCH, HIDDEN, + HIDDEN, LBRAC, EXIT], flags=F_IMMED) diff --git a/src/lib.4th b/src/lib.4th index 840ed4b..d599036 100644 --- a/src/lib.4th +++ b/src/lib.4th @@ -32,7 +32,7 @@ : LITERAL IMMEDIATE ['] LIT , , ; -: ' BL WORD FIND >CFA ; +: ' BL WORD FIND DROP ; : CHAR BL WORD 1+ @ ; : [CHAR] IMMEDIATE @@ -45,8 +45,7 @@ : [COMPILE] IMMEDIATE BL WORD \ get the next word - FIND \ find it in the dictionary - >CFA \ get its codeword + FIND DROP \ find it in the dictionary , \ and compile that ; @@ -516,8 +515,8 @@ DOES> @ : TO IMMEDIATE ( n -- ) BL WORD ( get the name of the value ) - FIND ( look it up in the dictionary ) - >CFA >BODY ( get a pointer to the first data field (the 'LIT') ) + FIND DROP ( look it up in the dictionary ) + >BODY ( get a pointer to the first data field (the 'LIT') ) STATE @ IF ( compiling? ) ['] LIT , ( compile LIT ) , ( compile the address of the value ) @@ -530,8 +529,8 @@ DOES> @ ( x +TO VAL adds x to VAL ) : +TO IMMEDIATE BL WORD ( get the name of the value ) - FIND ( look it up in the dictionary ) - >CFA >BODY ( get a pointer to the first data field (the 'LIT') ) + FIND DROP ( look it up in the dictionary ) + >BODY ( get a pointer to the first data field (the 'LIT') ) STATE @ IF ( compiling? ) ['] LIT , ( compile LIT ) , ( compile the address of the value ) @@ -555,8 +554,7 @@ DOES> @ ( PRINTING THE DICTIONARY ------------------------------------------------------ ) -: ID. - 1+ ( skip over the link pointer ) +: .NAME DUP @ ( get the flags/length byte ) F_LENMASK AND ( mask out the flags - just want the length ) @@ -594,7 +592,7 @@ DOES> @ ?DUP ( while link pointer is not null ) WHILE DUP ?HIDDEN NOT IF ( ignore hidden words ) - DUP ID. ( but if not hidden, print the word ) + DUP 1+ .NAME ( but if not hidden, print the word ) SPACE THEN @ ( dereference the link pointer - go to previous word ) @@ -602,15 +600,6 @@ DOES> @ CR ; - -( FORGET ---------------------------------------------------------------------- ) - -: FORGET - BL WORD FIND ( find the word, gets the dictionary entry address ) - DUP @ LATEST ! ( set LATEST to point to the previous word ) - H ! ( and store H with the dictionary address ) -; - ( DUMP ------------------------------------------------------------------------ ) \ TODO! @@ -618,31 +607,24 @@ DOES> @ ( DECOMPILER ------------------------------------------------------------------ ) -: CFA> - LATEST @ ( start at LATEST dictionary entry ) +: >NAME BEGIN - ?DUP ( while link pointer is not null ) - WHILE - 2DUP SWAP ( cfa curr curr cfa ) - < IF ( current dictionary entry < cfa? ) - NIP ( leave curr dictionary entry on the stack ) - EXIT - THEN - @ ( follow link pointer back ) - REPEAT - DROP ( restore stack ) - 0 ( sorry, nothing found ) + 1- DUP @ + NFA_MARK AND + NFA_MARK = UNTIL ; +: >LFA >NAME 1- ; + : SEE - BL WORD DUP FIND ( find the dictionary entry to decompile ) + BL WORD FIND ( find the dictionary entry to decompile ) - ?DUP 0= IF + 0= IF ." Word '" COUNT TYPE ." ' not found in dictionary." EXIT THEN - SWAP DROP + >LFA ( Now we search again, looking for the next word in the dictionary. This gives us the length of the word that we will be decompiling. (Well, mostly it does). ) @@ -663,17 +645,17 @@ DOES> @ DUP >CFA @ CASE DOCOL OF \ Colon definition - [CHAR] : EMIT SPACE DUP ID. SPACE + [CHAR] : EMIT SPACE DUP 1+ .NAME SPACE DUP ?IMMEDIATE IF ." IMMEDIATE " THEN CR ENDOF DOVAR OF \ Variable definition - ." Variable " DUP ID. CR + ." Variable " DUP 1+ .NAME CR 2DROP EXIT ENDOF DOCON OF \ Constant definition - ." Constant " DUP ID. CR + ." Constant " DUP 1+ .NAME CR 2DROP EXIT ENDOF @@ -682,10 +664,6 @@ DOES> @ DROP 2DROP EXIT ENDCASE - ( begin the definition with : NAME [IMMEDIATE] ) - ( [CHAR] : EMIT SPACE DUP ID. SPACE - DUP ?IMMEDIATE IF ." IMMEDIATE " THEN CR 4 ) - 4 SPACES >CFA >BODY ( get the data address, ie. points after DOCOL | end-of-word start-of-data ) @@ -725,8 +703,8 @@ DOES> @ ['] ['] OF ( is it ['] ? ) ." ['] " 1+ DUP @ ( get the next codeword ) - CFA> ( and force it to be printed as a dictionary entry ) - ID. SPACE + >NAME ( and force it to be printed as a dictionary entry ) + .NAME SPACE ENDOF ['] EXIT OF ( is it EXIT? ) ( We expect the last word to be EXIT, and if it is then we don't print it @@ -740,8 +718,8 @@ DOES> @ ENDOF ( default case: ) DUP ( in the default case we always need to DUP before using ) - CFA> ( look up the codeword to get the dictionary entry ) - ID. SPACE ( and print it ) + >NAME ( look up the codeword to get the dictionary entry ) + .NAME SPACE ( and print it ) ENDCASE 1+ ( end start+1 ) @@ -753,6 +731,19 @@ DOES> @ ; +( FORGET and HIDE ------------------------------------------------------------ ) + +: FORGET + BL WORD FIND >LFA ( find the word, gets the dictionary entry address ) + DUP @ LATEST ! ( set LATEST to point to the previous word ) + H ! ( and store H with the dictionary address ) +; + +: HIDE + BL WORD FIND DROP >NAME + DUP F_HIDDEN OR SWAP ! +; + ( MEMORY ------------------------------------------------------------------ ) : UNUSED ( -- cells )