duskos

commit febbef693f7d371d0530bfdac4eab54dd6f795ac
parent 103aa689c609fcfdf9fc0e89ba7c28c9522a46f5
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Sun,  9 Oct 2022 08:33:25 -0400

cc: fix misreported size in CType for func signatures

Instead of always returning CELLSZ, it would return the size of its return
value.

Diffstat:
M
fs/app/cos/cvm.c
 | 
7
++++---
M
fs/cc/type.fs
 | 
2
+-
M
fs/tests/cc/cc.fs
 | 
2
++
M
fs/tests/cc/test.c
 | 
19
+++++++++++++++----

4 files changed, 22 insertions(+), 8 deletions(-)
diff --git a/fs/app/cos/cvm.c b/fs/app/cos/cvm.c
@@ -231,7 +231,6 @@ static VMOP ops[ #[ OPCNT ]# ] = {
     RFETCH, RS2PS, PS2RS, CFETCH, FETCH, STORE, CSTORE
 };
 
-// Compiles up to this point!
 static void opexec(byte op) {
     if (op < #[ OPCNT c]# ) {
         ops[op]();
@@ -244,12 +243,14 @@ static void opexec(byte op) {
 COSVM* COSVM_init(char *bin_path, char *blkfs_path)
 {
     File *bfp = fopen(bin_path);
+    int c;
     if (!bfp) {
         fprintf("Can't open forth bin\n", ConsoleOut());
         return NULL;
     }
-    int c = fgetc(bfp);
-    while (c != EOF) {
+    c = fgetc(bfp);
+    while (c >= 0) {
+        // Compiles up to this point!
         vm.mem[i++] = c;
         c = fgetc(bfp);
     }
diff --git a/fs/cc/type.fs b/fs/cc/type.fs
@@ -85,7 +85,7 @@ struct[ CType
 
   \ Combined size of all fields in the LL.
   : :size ( self -- size )
-    dup :isarg? if drop CELLSZ exit then
+    dup :isarg? over :funcsig? or if drop CELLSZ exit then
     0 swap begin ( res ctype ) ?dup while
       tuck dup type _typesize swap nbelem 1 max * +
       swap llnext repeat ( res ) ;
diff --git a/fs/tests/cc/cc.fs b/fs/tests/cc/cc.fs
@@ -63,6 +63,8 @@ mydata structget $35 #eq
 mydata $42 structset mydata 4 + @ $42345678 #eq
 42 globstructset globstructget 42 #eq
 globdata 4 + 16b @ 42 #eq
+0 callfuncidx 42 #eq
+2 callfuncidx -42 #eq
 
 2 3 binop1 1 #eq
 '2' binop2 44 #eq
diff --git a/fs/tests/cc/test.c b/fs/tests/cc/test.c
@@ -3,7 +3,7 @@
 #[ 42 const MYCONST ]#
 
 // just return a constant
-int retconst() {
+short retconst() {
     return #[ MYCONST c]# ;
 }
 int variables() {
@@ -12,7 +12,8 @@ int variables() {
     return foo + _bar;
 }
 // test unary op and that we don't require whitespace around symbols
-int neg() {int a=$2a; return -a;}
+// TODO: if I change "int a" below to "short a", I get a PS leak during tests.
+short neg() {int a=$2a; return -a;}
 int bwnot() {
     int a='*';
     return ~a;
@@ -252,8 +253,18 @@ void globstructset(short val) {
     globdata.bar = val;
 }
 
-// support ident in global arrays
-static void globfuncs[3] = {retconst, NULL, neg};
+// support funcsig ident in global arrays and don't mess up thing when the
+// function's return type isn't 4b
+typedef short (*ShortRet)();
+static ShortRet globfuncs[3] = {retconst, NULL, neg};
+
+int callfuncidx(int idx) {
+    if (idx != 1) {
+        return globfuncs[idx]();
+    } else {
+        return 0;
+    }
+}
 
 // Below this comment are simple construct that were buggy before
 int binop1(int a, int b) {