Adding Recognizers, and more.

Adding the proposed recognizers vocabulary, including a limited test.
Fixing windows build to better handle different VS versions.
Fixing various hidden word bugs.
Adding 3DUP opcode.
Bumping version number.

BUILD

@@ -13,7 +13,7 @@
 # limitations under the License.
 
 SetVersions(
-    version='7.0.7.18',
+    version='7.0.7.19',
     stable='7.0.6.19',
     old_stable='7.0.5.4')
 

common/all_tests.fs

@@ -23,6 +23,7 @@ needs case_tests.fs
 needs doloop_tests.fs
 needs conditionals_tests.fs
 needs float_tests.fs
+needs recognizer_tests.fs
 needs forth_namespace_tests.fs
 needs structures_tests.fs
 needs fault_tests.fs

common/base_tests.fs

@@ -226,3 +226,12 @@ e: test-u<
   0 0 u< 0= assert
   -1 -1 u< 0= assert
 ;e
+
+e: test-postpone
+  : test postpone if postpone + postpone then ; immediate
+  : test2 test ;
+  3 4 1 test2 . cr
+  3 4 0 test2 . . cr
+  out: 7 
+  out: 4 3 
+;e

common/boot.fs

@@ -44,9 +44,9 @@ create AFT ' branch @ ' aft !         : aft   drop ['] aft , here 0 , here swap
 ( Recursion )
 : recurse   current @ @ aliteral ['] execute , ; immediate
 
-( Postpone - done here so we have ['] and IF )
+( Tools to build postpone later out of recognizers )
 : immediate? ( xt -- f ) >flags 1 and 0= 0= ;
-: postpone ' dup immediate? if , else aliteral ['] , , then ; immediate
+: postpone, ( xt -- ) aliteral ['] , , ;
 
 ( Rstack nest depth )
 variable nest-depth
@@ -55,6 +55,59 @@ variable nest-depth
 create FOR ' >r @ ' for !         : for   1 nest-depth +! ['] for , here ; immediate
 create NEXT ' donext @ ' next !   : next   -1 nest-depth +! ['] next , , ; immediate
 
+( Define a data type for Recognizers. )
+: RECTYPE: ( xt1 xt2 xt3 "name" -- ) CREATE , , , ;
+: do-notfound ( a n -- ) -1 'notfound @ execute ;
+' do-notfound ' do-notfound ' do-notfound  RECTYPE: RECTYPE-NONE
+' execute     ' ,           ' postpone,    RECTYPE: RECTYPE-WORD
+' execute     ' execute     ' ,            RECTYPE: RECTYPE-IMM
+' drop        ' execute     ' execute      RECTYPE: RECTYPE-NUM
+
+: RECOGNIZE ( c-addr len addr1 -- i*x addr2 )
+  dup @ for aft
+    cell+ 3dup >r >r >r @ execute
+    dup RECTYPE-NONE <> if rdrop rdrop rdrop rdrop exit then
+    drop r> r> r>
+  then next
+  drop 2drop RECTYPE-NONE
+;
+
+( Define a recognizer stack. )
+create RECSTACK 0 , 10 cells allot
+: +RECOGNIZER ( xt -- ) 1 RECSTACK +! RECSTACK dup @ cells + ! ;
+: -RECOGNIZER ( -- ) -1 RECSTACK +! ;
+: GET-RECOGNIZERS ( -- xtn..xt1 n )
+   RECSTACK @ for RECSTACK r@ cells + @ next ;
+: SET-RECOGNIZERS ( xtn..xt1 n -- )
+   0 RECSTACK ! for aft +RECOGNIZER then next ;
+
+( Create recognizer based words. )
+: postpone ( "name" -- ) bl parse RECSTACK RECOGNIZE @ execute ; immediate
+: +evaluate1
+  bl parse dup 0= if 2drop exit then
+  RECSTACK RECOGNIZE state @ 2 + cells + @ execute
+;
+
+( Setup recognizing words. )
+: REC-FIND ( c-addr len -- xt addr1 | addr2 )
+  find dup if
+    dup immediate? if RECTYPE-IMM else RECTYPE-WORD then
+  else
+    drop RECTYPE-NONE
+  then
+;
+' REC-FIND +RECOGNIZER
+
+( Setup recognizing integers. )
+: REC-NUM ( c-addr len -- n addr1 | addr2 )
+  s>number? if
+    ['] aliteral RECTYPE-NUM
+  else
+    RECTYPE-NONE
+  then
+;
+' REC-NUM +RECOGNIZER
+
 ( DO..LOOP )
 variable leaving
 : leaving,   here leaving @ , leaving ! ;

common/floats.fs

@@ -23,6 +23,18 @@
 6 value precision
 : set-precision ( n -- ) to precision ;
 
+( Add recognizer for floats. )
+also recognizers definitions
+: REC-FNUM ( c-addr len -- f addr1 | addr2 )
+  s>float? if
+    ['] afliteral RECTYPE-NUM
+  else
+    RECTYPE-NONE
+  then
+;
+' REC-FNUM +RECOGNIZER
+previous definitions
+
 internals definitions
 : #f+s ( r -- ) fdup precision for aft 10e f* then next
                 precision for aft fdup f>s 10 mod [char] 0 + hold 0.1e f* then next

common/floats.h

@@ -42,7 +42,8 @@
   X("1/F", FINVERSE, *fp = 1.0f / *fp) \
   X("S>F", STOF, *++fp = (float) tos; DROP) \
   X("F>S", FTOS, DUP; tos = (cell_t) *fp--) \
-  XV(internals, "S>FLOAT?", FCONVERT, tos = fconvert((const char *) *sp, tos, fp)|0; --sp) \
+  XV(internals, "S>FLOAT?", FCONVERT, \
+      ++fp; tos = fconvert((const char *) *sp, tos, fp)|0; if (!tos) --fp; --sp) \
   Y(SFLOAT, DUP; tos = sizeof(float)) \
   Y(SFLOATS, tos *= sizeof(float)) \
   X("SFLOAT+", SFLOATPLUS, tos += sizeof(float)) \

common/forth_namespace_tests.fs

@@ -106,7 +106,6 @@ e: check-boot
   out: value 
   out: throw 
   out: catch 
-  out: handler 
   out: K 
   out: J 
   out: I 
@@ -116,10 +115,10 @@ e: check-boot
   out: UNLOOP 
   out: ?do 
   out: do 
+  out: postpone 
   out: next 
   out: for 
-  out: nest-depth 
+  out: postpone, 
-  out: postpone 
   out: recurse 
   out: aft 
   out: repeat 
@@ -194,6 +193,7 @@ e: check-tier1-opcodes
   out: cell/ 
   out: 2drop 
   out: 2dup 
+  out: 3dup 
   out: 2@ 
   out: 2! 
 
@@ -390,6 +390,7 @@ e: check-blocks
 ;e
 
 e: check-vocabulary
+  out: recognizers 
   out: internals 
   out: sealed 
   out: previous 
@@ -537,6 +538,7 @@ e: test-windows-forth-voclist
   out: tasks 
   out: windows 
   out: structures 
+  out: recognizers 
   out: internalized 
   out: internals 
   out: FORTH 
@@ -576,6 +578,7 @@ e: test-posix-forth-voclist
   out: tasks 
   out: posix 
   out: structures 
+  out: recognizers 
   out: internalized 
   out: internals 
   out: FORTH 
@@ -635,6 +638,7 @@ e: test-esp32-forth-voclist
   out: Wire 
   out: ESP 
   out: structures 
+  out: recognizers 
   out: internalized 
   out: internals 
   out: FORTH 

common/io.fs

@@ -105,7 +105,7 @@ sp0 'stack-cells @ 2 3 */ cells + constant sp-limit
 
 ( REPL )
 : prompt   ."  ok" cr ;
-: evaluate-buffer   begin >in @ #tib @ < while evaluate1 ?stack repeat ;
+: evaluate-buffer   begin >in @ #tib @ < while ?stack +evaluate1 repeat ?stack ;
 : evaluate ( a n -- ) 'tib @ >r #tib @ >r >in @ >r
                       #tib ! 'tib ! 0 >in ! evaluate-buffer
                       r> >in ! r> #tib ! r> 'tib ! ;

common/recognizer_tests.fs

@@ -0,0 +1,32 @@
+\ Copyright 2024 Bradley D. Nelson
+\
+\ Licensed under the Apache License, Version 2.0 (the "License");
+\ you may not use this file except in compliance with the License.
+\ You may obtain a copy of the License at
+\
+\     http://www.apache.org/licenses/LICENSE-2.0
+\
+\ Unless required by applicable law or agreed to in writing, software
+\ distributed under the License is distributed on an "AS IS" BASIS,
+\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+\ See the License for the specific language governing permissions and
+\ limitations under the License.
+
+e: test-recognizers
+  also recognizers
+  also internals
+  : rec-blah ( a n -- rec )
+    s" blah" str= if
+      123 ['] aliteral rectype-num
+    else
+      rectype-none
+    then
+  ;
+  ' rec-blah +recognizer
+  : test blah . cr ;
+  -recognizer
+  previous
+  previous
+  test
+  out: 123 
+;e

common/tier1_opcodes.h

@@ -47,6 +47,7 @@
   X("cell/", CELLSLASH, CELLSLASH_FUNC) \
   X("2drop", TWODROP, NIP; DROP) \
   X("2dup", TWODUP, DUP; tos = sp[-1]; DUP; tos = sp[-1]) \
+  X("3dup", THREEDUP, sp += 3; sp[-2] = tos; sp[-1] = sp[-4]; *sp = sp[-3]) \
   X("2@", TWOAT, DUP; *sp = *(cell_t *) tos; tos = ((cell_t *) tos)[1]) \
   X("2!", TWOSTORE, *(cell_t *) tos = sp[-1]; \
       ((cell_t *) tos)[1] = *sp; sp -= 2; DROP) \

common/vocabulary.fs

@@ -61,9 +61,10 @@ transfer{
   tib-setup input-limit sp-limit ?stack
   [SKIP] [SKIP]' raw-ok boot-prompt free.
   $place zplace BUILTIN_MARK
+  nest-depth handler +evaluate1 do-notfound
 }transfer
 
-( Move branching opcodes to separate vocabulary )
+( Move branching opcodes to separate vocabulary. )
 vocabulary internalized  internalized definitions
 : cleave   ' >link xt-transfer ;
 cleave begin   cleave again   cleave until
@@ -72,7 +73,17 @@ cleave else    cleave while   cleave repeat
 cleave aft     cleave for     cleave next
 cleave do      cleave ?do     cleave +loop
 cleave loop    cleave leave
+forth definitions
 
+( Move recognizers to separate vocabulary )
+vocabulary recognizers  recognizers definitions
+transfer{
+  REC-FIND REC-NUM
+  RECTYPE: RECTYPE-NONE RECTYPE-WORD RECTYPE-IMM RECTYPE-NUM
+  SET-RECOGNIZERS GET-RECOGNIZERS
+  -RECOGNIZER +RECOGNIZER RECSTACK
+  RECOGNIZE
+}transfer
 forth definitions
 
 ( Make DOES> switch to compile mode when interpreted )

configure.py

@@ -89,27 +89,10 @@ elif sys.platform == 'linux':
 
 LIBS = ['-ldl']
 
-WIN_CFLAGS = CFLAGS_COMMON + [
+WIN_CFLAGS = CFLAGS_COMMON
-  '-I', '"c:/Program Files (x86)/Microsoft SDKs/Windows/v7.1A/Include"',
+WIN_LIBS = ['user32.lib']
-  '-I', '"c:/Program Files (x86)/Microsoft Visual Studio/2019/Community/VC/Tools/MSVC/14.28.29333/include"',
+WIN_LFLAGS32 = []
-  '-I', '"c:/Program Files (x86)/Windows Kits/10/Include/10.0.19041.0/ucrt"',
+WIN_LFLAGS64 = []
-]
-
-WIN_LIBS = [
-  'user32.lib',
-]
-
-WIN_LFLAGS32 = [
-  '/LIBPATH:"c:/Program Files (x86)/Microsoft SDKs/Windows/v7.1A/Lib"',
-  '/LIBPATH:"c:/Program Files (x86)/Microsoft Visual Studio/2019/Community/VC/Tools/MSVC/14.28.29333/lib/x86"',
-  '/LIBPATH:"c:/Program Files (x86)/Windows Kits/10/Lib/10.0.19041.0/ucrt/x86"',
-] + WIN_LIBS
-
-WIN_LFLAGS64 = [
-  '/LIBPATH:"c:/Program Files (x86)/Microsoft SDKs/Windows/v7.1A/Lib/x64"',
-  '/LIBPATH:"c:/Program Files (x86)/Microsoft Visual Studio/2019/Community/VC/Tools/MSVC/14.28.29333/lib/x64"',
-  '/LIBPATH:"c:/Program Files (x86)/Windows Kits/10/Lib/10.0.19041.0/ucrt/x64"',
-] + WIN_LIBS
 
 WEB_ENABLED = False
 PICO_ICE_ENABLED = False
@@ -156,9 +139,10 @@ def DetectWindowsTools(args):
   ARDUINO_CLI = LOCALAPPDATA + '/Programs/arduino-ide/resources/app/lib/backend/resources/arduino-cli.exe'
   WINTMP = LOCALAPPDATA + '/Temp'
   WINTMPR = LOCALAPPDATAR + '/Temp'
-  PROGFILES = '/mnt/c/Program Files (x86)'
+  PROGFILES = '/mnt/c/Program Files'
+  PROGFILES_X86 = '/mnt/c/Program Files (x86)'
   MSVS = PROGFILES + '/Microsoft Visual Studio'
-  MSKITS = PROGFILES + '/Windows Kits'
+  MSKITS = PROGFILES_X86 + '/Windows Kits'
   try:
     WIN_CL32 = LSQ(MSVS + '/*/*/VC/Tools/MSVC/*/bin/Hostx86/x86/cl.exe')
     WIN_CL64 = LSQ(MSVS + '/*/*/VC/Tools/MSVC/*/bin/Hostx86/x64/cl.exe')
@@ -166,6 +150,26 @@ def DetectWindowsTools(args):
     WIN_LINK64 = LSQ(MSVS + '/*/*/VC/Tools/MSVC/*/bin/Hostx86/x64/link.exe')
     WIN_RC32 = LSQ(MSKITS + '/*/bin/*/x86/rc.exe')
     WIN_RC64 = LSQ(MSKITS + '/*/bin/*/x64/rc.exe')
+    WIN_TOOL_ROOT = WIN_CL32.replace('/mnt/c/', 'c:/').replace('/bin/Hostx86/x86/cl.exe', '').replace('"', '')
+    WINDOWS_H = LSQ(MSKITS + '/*/Include/*/um/windows.h')
+    WINKIT_HEADERS = WINDOWS_H.replace('/mnt/c/', 'c:/').replace('/um/windows.h', '').replace('"', '')
+    WINKIT_LIBS = WINKIT_HEADERS.replace('/Include/', '/Lib/')
+    WIN_CFLAGS.extend([
+      '-I', '"%s/include"' % WIN_TOOL_ROOT,
+      '-I', '"%s/um"' % WINKIT_HEADERS,
+      '-I', '"%s/ucrt"' % WINKIT_HEADERS,
+      '-I', '"%s/shared"' % WINKIT_HEADERS,
+    ])
+    WIN_LFLAGS32.extend([
+      '/LIBPATH:"%s/lib/x86"' % WIN_TOOL_ROOT,
+      '/LIBPATH:"%s/ucrt/x86"' % WINKIT_LIBS,
+      '/LIBPATH:"%s/um/x86"' % WINKIT_LIBS,
+    ])
+    WIN_LFLAGS64.extend([
+      '/LIBPATH:"%s/lib/x64"' % WIN_TOOL_ROOT,
+      '/LIBPATH:"%s/ucrt/x64"' % WINKIT_LIBS,
+      '/LIBPATH:"%s/um/x64"' % WINKIT_LIBS,
+    ])
   except:
     if not args.quiet:
       sys.stderr.write('Windows tools not available, Windows support disabled.\n')
@@ -250,6 +254,7 @@ D8 = {D8}
 WIN_CFLAGS = {' '.join(WIN_CFLAGS)}
 WIN_LFLAGS32 = {' '.join(WIN_LFLAGS32)}
 WIN_LFLAGS64 = {' '.join(WIN_LFLAGS64)}
+WIN_LIBS = {' '.join(WIN_LIBS)}
 
 rule config
   description = CONFIG
@@ -297,11 +302,11 @@ rule compile_win64
 
 rule link_win32
   description = WIN_LINK32 $in
-  command = $WIN_LINK32 /nologo /OUT:$out $WIN_LFLAGS32 $in && touch $out && chmod a+x $out
+  command = $WIN_LINK32 /nologo /OUT:$out $WIN_LFLAGS32 $WIN_LIBS $in && touch $out && chmod a+x $out
 
 rule link_win64
   description = WIN_LINK64 $in
-  command = $WIN_LINK64 /nologo /OUT:$out $WIN_LFLAGS64 $in && touch $out && chmod a+x $out
+  command = $WIN_LINK64 /nologo /OUT:$out $WIN_LFLAGS64 $WIN_LIBS $in && touch $out && chmod a+x $out
 
 rule rc_win32
   description = WIN_RC32 $in

tools/check_web_sanity.py

@@ -23,7 +23,7 @@ if 'Invalid' in source:
   print(source)
   sys.exit(1)
 
-if not source.strip().endswith('--> 123'):
+if not source.strip().endswith('\n--> 123'):
   print('MISSING EXPECTED OUTPUT')
   print(source)
   sys.exit(1)

web/fuse_web.js

@@ -86,12 +86,16 @@ cases = ReplaceAll(cases, 'fp[-2]', 'fround(f32[(fp - 8)>>2])');
 
 cases = ReplaceAll(cases, /[*](.)p = /, 'i32[$1p>>2] = ');
 cases = ReplaceAll(cases, 'sp[-1] = ', 'i32[(sp - 4)>>2] = ');
+cases = ReplaceAll(cases, 'sp[-2] = ', 'i32[(sp - 8)>>2] = ');
 cases = ReplaceAll(cases, /[*](.)p/, '(i32[$1p>>2]|0)');
 cases = ReplaceAll(cases, 'sp[-1]', '(i32[(sp - 4)>>2]|0)');
+cases = ReplaceAll(cases, 'sp[-3]', '(i32[(sp - 12)>>2]|0)');
+cases = ReplaceAll(cases, 'sp[-4]', '(i32[(sp - 16)>>2]|0)');
 
 cases = ReplaceAll(cases, /([+-]).(.)p/, '$2p = ($2p $1 4) | 0');
 cases = ReplaceAll(cases, 'sp -= (2-1)', 'sp = (sp - 4) | 0');
 cases = ReplaceAll(cases, 'sp -= 2', 'sp = (sp - 8) | 0');
+cases = ReplaceAll(cases, 'sp += 3', 'sp = (sp + 12) | 0');
 cases = ReplaceAll(cases, 'fp -= 2', 'fp = (fp - 8) | 0');
 cases = ReplaceAll(cases, 'sizeof(cell_t)', '4');
 cases = ReplaceAll(cases, 'sizeof(float)', '4');