duskos

commit da6b34b8eab35112f5315f5247b871859bb4d00c
parent 0c375ee52f41dc4f6b73aafed180493568464688
Author: binarycat <binarycat@envs.net>
Date:   Wed, 22 Jun 2022 15:16:10 -0400

Add sys/annotate

Diffstat:
M
fs/lib/core.fs
 | 
15
+++++++++++++--
M
fs/lib/str.fs
 | 
3
++-
A
fs/sys/annotate/annotate.fs
 | 
12
++++++++++++
A
fs/sys/annotate/doc.fs
 | 
20
++++++++++++++++++++
M
fs/tests/core.fs
 | 
5
+++++

5 files changed, 52 insertions(+), 3 deletions(-)
diff --git a/fs/lib/core.fs b/fs/lib/core.fs
@@ -46,13 +46,20 @@ $08 const BS  $04 const EOF
 : repeat [compile] again [compile] then ; immediate
 
 \ Dictionary
-: prevword ( w -- w ) 5 - @ ;
+: preventry ( w -- w ) 5 - @ ;
+: preventry! ( w w -- ) 5 - ! ;
 : wordlen ( w -- len ) 1- c@ $3f and ;
 : wordname[] ( w -- sa sl )
   dup wordlen swap 5 - over - ( sl sa ) swap ;
+
+: word? ( w -- f ) wordname[] if c@ 127 = not else drop 0 then ;
+: (prevword) ( w -- w ) begin dup while dup word? not while preventry repeat then ;
+: prevword ( w -- w ) preventry (prevword) ;
+: lastword ( -- w ) current (prevword) ;
 : .word ( w -- ) wordname[] rtype ;
 : words ( -- )
-  current begin dup while dup .word spc> prevword repeat drop ;
+  lastword begin dup while dup .word spc> prevword repeat drop ;
+
 
 \ case..endcase
 \ The case statement is very similar to what we see in other forths, but with
@@ -90,3 +97,7 @@ create _ ," 0123456789abcdef"
     8 >r begin Ac@+ .x1 Ac@+ .x1 spc> next ( a ) >A
     16 >r begin Ac@+ dup SPC - $5e > if drop '.' then emit next
   nl> next r>A ;
+
+\ doc comment placeholder
+alias \ \\
+
diff --git a/fs/lib/str.fs b/fs/lib/str.fs
@@ -1,6 +1,7 @@
 \ String utilities
 
-$100 value STR_MAXSZ \ maximum size of strings (including size byte)
+\\ maximum size of strings (including size byte)
+$100 value STR_MAXSZ 
 
 \ is c a whitespace?
 : ws? ( c -- f ) SPC <= ;
diff --git a/fs/sys/annotate/annotate.fs b/fs/sys/annotate/annotate.fs
@@ -0,0 +1,12 @@
+: (annotate) ( w -- w' )
+  current dup preventry to current >r
+  dup preventry r@ preventry!
+  r@ swap preventry! r> ;
+
+: annotate (annotate) drop ;
+
+: [][]= ( a u a u -- f )
+  rot over = if []= else 2drop drop 0 then ;
+
+: has-name? ( w str -- f )
+  c@+ rot wordname[] [][]= ;
diff --git a/fs/sys/annotate/doc.fs b/fs/sys/annotate/doc.fs
@@ -0,0 +1,20 @@
+create doc-magic 2 c, 127 c, 'D' c,
+
+: _ doc-magic entry begin in< dup c, $0a = until ;
+' _ to \\
+
+: add-doc ( w -- )
+  begin current word? not while (annotate) repeat drop ;
+
+: .doc ( w -- )
+  preventry dup word? not if dup .doc then
+  dup doc-magic has-name? if
+    begin c@+ dup emit $0a = until 
+  then drop ;
+
+: doc ' .doc ;
+
+\\ print top of stack in hexidecimal
+' .x add-doc
+
+
diff --git a/fs/tests/core.fs b/fs/tests/core.fs
@@ -38,4 +38,9 @@ to' foo @ 48 #eq
 6 foo 209 #eq
 20 foo 220 #eq
 
+\ prevword
+: bar ;
+: baz ;
+' baz prevword ' bar #eq
+
 testend