Merge vocabularies and wordlists

In particular, the system can do introspection on wordlists

core.fs

@@ -90,9 +90,11 @@
 
 \ Dictionary's entries (name token -- NT )
 
+: nt>cname ( nop ) ;
+
 \ Get the NT of the last-defined word.
 : nt>name ( nt -- addr u )
-    dup c@ swap 1+ swap ;
+    nt>cname dup c@ swap 1+ swap ;
 : previous-word
     cell - @ ;
 

forth.S

@@ -3,7 +3,7 @@
             Minimal on-the-metal Forth implementation for x86
 */
 
-/* Copyright (C) 2011 David Vázquez Púa */
+/* Copyright (C) 2011, 2012 David Vázquez Púa */
 /*
  * This program is free software: you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -80,7 +80,7 @@ flush_gdt:
 .lcomm rstack, RSTACK_SIZE
 
 /* Pointer to the last word which was defined in the built-in wordlist. */
-.lcomm builtin_wordlist, 8
+.lcomm builtin_wordlist, 16
 
 .data
 
@@ -979,12 +979,14 @@ BUILTIN_VARIABLE(state, 0)
             +--------------+
             |    method    | <-- XT of a word which finding words in the wordlist
             +--------------+     relies on. It takes a counted-string from the
-                                 data stack and push associated NT, or 0 if it is
-                                 not found. It could also be zero to indicate that
-                                 the default search method will be used.
+            |   reserved   |     data stack and push associated NT, or 0 if it is
+            +--------------+     not found. It could also be zero to indicate that
+            |   reserved   |     the default search method will be used.
+            +--------------+
 
-   The wordlist's identifier (WID) is a pointer to that structure.
-*/
+   The wordlist's identifier (WID) is a pointer to that structure. The
+   two reserved cells are provided to implement VOCS and MARKER
+   words. But the core does not know anything about that. */
 
 BUILTIN_VARIABLE(current, 0)
 
@@ -1488,6 +1490,8 @@ nomultiboot:
         movl (dictionary_end-4), %eax
         movl %eax, builtin_wordlist
         movl $0, builtin_wordlist+4
+        movl $0, builtin_wordlist+8
+        movl $0, builtin_wordlist+12
         movl $builtin_wordlist, sorder_stack
         movl $builtin_wordlist, current
         /* Load core.fs */

tools.fs

@@ -45,8 +45,7 @@
 : room
     CR
     ." Words in the context: " room-count . CR
-    ." Dictionary space allocated: " dp dp-base - . ." bytes" cr
-;
+    ." Dictionary space allocated: " dp dp-base - . ." bytes" cr ;
 
 
 \ Display the content of the variable ADDR.
@@ -127,47 +126,20 @@ variable backtrace-limit
     drop ;
 
 
-( Display the list of vocabularies in the system )
+( Display the list of vocabularies in the system and the search order stack )
 
-: vocs-print-vocentry ( ve -- )
-    vocentry>name type space ;
+: .wid ( wid -- )
+    wid>name ?dup if type space else ." ??? " drop then ;
 
 : vocs
-    vocentry-root @
-    begin
-    ?dup while
-        dup vocs-print-vocentry
-        vocentry-previous @
+    last-wid @
+    begin ?dup while
+        dup .wid
+        wid-previous @
     repeat ;
 
-
-( Display the order stack and the current word list )
-
-: wid>name ( wid -- addr n )
-    vocentry-root @
-    begin
-    ?dup while
-        2dup vocentry-wid @ = if
-            nip vocentry>name exit
-        else
-            vocentry-previous @
-        endif
-    repeat
-    drop 0 0 ;
-
-: anonymous-wid? ( wid -- )
-    wid>name nip 0= ;
-
-: print-wid ( wid -- )
-    dup anonymous-wid? if
-        drop ." ??? "
-    else
-        wid>name type space
-    endif ;
-
 : order
-    get-order 0 ?do print-wid loop
-    4 spaces current @ print-wid ;
+    get-order 0 ?do .wid loop 4 spaces current @ .wid ;
 
 Root definitions
 ' order alias order

vocabulary.fs

@@ -1,6 +1,6 @@
 \ vocabulary.fs --
 
-\ Copyright 2011 (C) David Vazquez
+\ Copyright 2011, 2012 (C) David Vazquez
 
 \ This file is part of Eulex.
 
@@ -19,29 +19,35 @@
 
 require @structures.fs
 
-\ Low-level search-order manipulation
+variable last-wid
 
 struct
     cell field wid-latest
     cell field wid-method
+    cell field wid-name
+    cell field wid-previous
 end-struct wid%
 
 : wid>latest wid-latest @ ;
 
+: wid>name ( wid -- addr n )
+    wid-name @ ?dup if count else 0 0 then ;
+
 : context
     sorder_stack sorder_tos @ cells + ;
 
+context @ constant forth-impl-wordlist
 : forth-impl
-    [ context @ ]L context ! ;
+    forth-impl-wordlist context ! ;
+forth-impl-wordlist last-wid !
 
 : get-order ( -- widn .. wid1 n )
     sorder_stack
     sorder_tos @ 1+ 0 ?do
         dup @ swap cell +
     loop
     drop
-    sorder_tos @ 1+
-;
+    sorder_tos @ 1+ ;
 
 : set-order ( widn .. wid1 n -- )
     dup 0= if
@@ -55,8 +61,7 @@ end-struct wid%
             dup -rot ! cell -
         loop
         drop
-    then
-;
+    then ;
 
 : get-current current @ ;
 : set-current current ! ;
@@ -67,9 +72,12 @@ end-struct wid%
 : definitions
     context @ current ! ;
 
-: wordlist ( -- wid)
+: allocate-wordlist ( -- wid )
     here wid% zallot ;
 
+: wordlist ( -- wid )
+    here allocate-wordlist last-wid @ over wid-previous ! last-wid ! ;
+
 : also
     sorder_tos @ sorder_size < if
         context @
@@ -100,60 +108,24 @@ end-struct wid%
     postpone repeat
 ; immediate compile-only
 
-
-\ In order to implement VOCS word, we need a kind of introspection for
-\ vocabularies. This is provided storing a single-linked list of the
-\ available vocabularies in the system.
-
-variable vocentry-root
-
-struct
-    1 cells field vocentry-previous
-    1 cells field vocentry-size
-    1 cells field vocentry-wid
-    0 cells field vocentry-name
-end-struct vocentry%
-
-: ,vocentry
-    vocentry-root @ , dup , 0 , s, ;
-
-: add-vocentry
-    here -rot ,vocentry vocentry-root ! ;
-
-: set-last-vocentry-wid ( wid -- )
-    vocentry-root @ vocentry-wid ! ;
-
-: vocentry>name ( vc -- addr n )
-    dup vocentry-name swap vocentry-size @ ;
-
-: create-vocabulary ( -- wid )
-    create wordlist does> context ! ;
+\ Vocabularies
 
 : vocabulary
-    create-vocabulary
-    latest nt>name add-vocentry
-    set-last-vocentry-wid ;
+    create latest nt>cname wordlist wid-name ! does> context ! ;
 
 \ Define Forth and Root vocabularies
-
 wordlist constant forth-wordlist
-: Forth forth-wordlist context ! ;
-latest nt>name add-vocentry
-forth-wordlist set-last-vocentry-wid
-
 wordlist constant root-wordlist
-: Root root-wordlist >order ;
-latest nt>name add-vocentry
-root-wordlist set-last-vocentry-wid
 
+: Forth forth-wordlist context ! ;
+: Root root-wordlist >order ;
 : Eulex forth-impl ;
-latest nt>name add-vocentry
-context @ set-last-vocentry-wid
 
-: only
-    sorder_tos 0!
-    root-wordlist context !
-    also ;
+nt' Forth nt>cname forth-wordlist      wid-name !
+nt' Root  nt>cname root-wordlist       wid-name !
+nt' Eulex nt>cname forth-impl-wordlist wid-name !
+
+: only sorder_tos 0! root-wordlist context ! also ;
 
 Root definitions
 ' set-order alias set-order