duskos

commit 388f40446ef4d4499c191eb54cd7f24da4bb1b7c
parent ba300dc8c4b2110fdf777db69ba79a1e7e200905
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Tue, 13 Sep 2022 16:29:18 -0400

Add word signature metadata

For now, we only collect arg/ret counts. This will be useful for compiling
"system" words in CC.

Diffstat:
M
fs/lib/meta.fs
 | 
6
++++++
M
fs/tests/kernel.fs
 | 
9
+++++++++
M
fs/xcomp/bootlo.fs
 | 
22
++++++++++++++--------

3 files changed, 29 insertions(+), 8 deletions(-)
diff --git a/fs/lib/meta.fs b/fs/lib/meta.fs
@@ -17,6 +17,12 @@
     dup while 2dup emetatype = not while llnext repeat
     ( success ) then ( typeid ll-or-0 ) nip ;
 
+\ Docstring
 : .doc ( w -- ) emeta begin ( ll )
     EMETA_DOCLINE swap findemeta ?dup while ( ll )
     dup 'emetadata begin c@+ dup emit LF = until drop llnext repeat ;
+
+\ Signature
+: wordsig ( w -- argcnt retcnt )
+  emeta EMETA_SIGCNT swap findemeta dup if ( ll )
+    'emetadata dup c@ swap 1+ c@ else ( 0 ) 0 then ;
diff --git a/fs/tests/kernel.fs b/fs/tests/kernel.fs
@@ -14,6 +14,15 @@ foo 43 #eq
 foo 48 #eq
 to' foo @ 48 #eq
 
+\ signatures
+' foo wordsig 1 #eq 0 #eq
+' here wordsig 1 #eq 0 #eq
+(S a b c -- d e )
+: someword ;
+' someword wordsig 2 #eq 3 #eq
+: someword ;
+' someword wordsig 0 #eq 0 #eq
+
 \ alias chaining
 alias 1+ foo
 : myfoo ( n 'foo -- n ) execute << ; \ (n+1)*2
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -103,9 +103,6 @@ create _ 0 ,
 : toexec ( a w -- ) compiling if
     swap litn 0 toptr @! ?dup if nip then execute, else
     0 toptr @! ?dup if nip then execute then ;
-: value doer , immediate does> ['] @ toexec ;
-: ivalue doer , immediate does> @ ['] @ toexec ;
-HERE ivalue here
 : _ @ execute ;
 : alias ' doer , immediate does> ['] _ toexec ;
 : ialias doer , immediate does> @ ['] _ toexec ;
@@ -156,8 +153,8 @@ $20 const SPC $0d const CR $0a const LF $08 const BS
 \ emit all chars of "str"
 : stype ( str -- ) c@+ rtype ;
 : S" ( comp: -- ) ( not-comp: -- str )
-  compiling if compile (s) else here then
-  here 1 allot here ," here -^ ( 'len len ) swap c! ; immediate
+  compiling if compile (s) else HERE @ then
+  HERE @ 1 allot HERE @ ," HERE @ -^ ( 'len len ) swap c! ; immediate
 : ."
   compiling if [compile] S" compile stype else
     begin "< dup 0>= while emit repeat drop then ; immediate
@@ -174,14 +171,23 @@ alias noop [then]
 : llprev ( tgt ll -- prev )
   begin 2dup llnext = not while llnext ?dup while repeat
   abort" llprev failed" then nip ;
-: lladd ( ll -- newll ) here swap llend ! here 0 , ;
-: llinsert ( 'll -- newll ) here over @ , ( 'll newll ) dup rot ! ;
+: lladd ( ll -- newll ) HERE @ swap llend ! HERE @ 0 , ;
+: llinsert ( 'll -- newll ) HERE @ over @ , ( 'll newll ) dup rot ! ;
 : llcnt ( ll -- count ) 0 >r begin ?dup while 1 to+ V1 llnext repeat r> ;
 
-\ Docstrings
+\ Entry metadata
 1 const EMETA_DOCLINE \ a doc strings that ends with LF
 \ a \\ comment goes before the creation of the word it comments
 : \\ nextmeta lladd drop EMETA_DOCLINE , begin IN< @ execute dup c, LF = until ;
+2 const EMETA_SIGCNT  \ 1b arg count, 1b result count
+: sigcnt, ( argcnt retcnt -- ) nextmeta lladd drop EMETA_SIGCNT , swap c, c, ;
+: (S -1 begin ( cnt )
+    1+ word S" )" s= if abort" not a signature" then curword S" --" s= until
+  -1 begin ( cnt ) 1+ word S" )" s= until sigcnt, ;
+
+: value 0 1 sigcnt, doer , immediate does> ['] @ toexec ;
+: ivalue 0 1 sigcnt, doer , immediate does> @ ['] @ toexec ;
+HERE ivalue here
 
 \ Alias chaining. See doc/usage.
 : _ ( 'target 'alias -- )