commit d6c5cc159cb4924fe9133c47000593e380dfd2f3
parent ba9d67b74f468e0c9a66fb00670e13ae9eb5e8ef
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Mon, 10 Oct 2022 10:13:23 -0400
cc: add CType :export
Also, begin to restructure COS' cvm in a way that is more Dusk-friendly.
Diffstat:
6 files changed, 46 insertions(+), 42 deletions(-)
diff --git a/fs/app/cos/cvm.c b/fs/app/cos/cvm.c
@@ -36,8 +36,8 @@ struct COSVM {
word minSP;
int running;
};
-static COSVM vm;
-static File *blkfp;
+COSVM vm;
+File *blkfp = NULL;
/* Stores blkop command. Bytes flow from left (byte 0) to right (byte 3)
* We know we have a full command when last byte is nonzero. After
* processing the cmd, we reset blkop to 0. */
@@ -211,13 +211,15 @@ static void LT() {
#[ 67 const OPCNT ]#
static VMOP ops[ #[ OPCNT ]# ] = {
- DUP, DROP, PUSHi, PUSHii, SWAP, OVER, ROT, lblnext, CBR, NEXT,
- CALLi, JMPi, lblxt, EXIT, CDUP, LIT8, LIT16, JMPii, lbldoes, lblval,
- NULL, EXECUTE, NULL, NULL, NULL, NULL, RDROP, NULL, PLUS, SUB, BR,
- NULL, NULL, LT, NULL, NULL, NULL, NULL, NOT, AND, OR, XOR,
- NULL, NULL, NULL, NULL, NULL, NULL, NULL,
- NULL, NULL, PCSTORE, PCFETCH, MULT, DIVMOD, QUIT, ABORT, RCNT, SCNT, BYE,
- RFETCH, RS2PS, PS2RS, CFETCH, FETCH, STORE, CSTORE
+ DUP, DROP, PUSHi, PUSHii, SWAP, OVER, ROT, lblnext,
+ CBR, NEXT, CALLi, JMPi, lblxt, EXIT, CDUP, LIT8,
+ LIT16, JMPii, lbldoes, lblval, NULL, EXECUTE, NULL, NULL,
+ NULL, NULL, RDROP, NULL, PLUS, SUB, BR, NULL,
+ NULL, LT, NULL, NULL, NULL, NULL, NOT, AND,
+ OR, XOR, NULL, NULL, NULL, NULL, NULL, NULL,
+ NULL, NULL, NULL, PCSTORE, PCFETCH, MULT, DIVMOD, QUIT,
+ ABORT, RCNT, SCNT, BYE, RFETCH, RS2PS, PS2RS, CFETCH,
+ FETCH, STORE, CSTORE
};
static void opexec(byte op) {
@@ -229,31 +231,8 @@ static void opexec(byte op) {
}
}
-COSVM* COSVM_init(char *bin_path, char *blkfs_path)
+void COS_init()
{
- File *bfp = fopen(bin_path);
- int c, i=0;
- if (!bfp) {
- fprintf("Can't open forth bin\n", ConsoleOut());
- return NULL;
- }
- c = fgetc(bfp);
- while (c >= 0) {
- vm.mem[i++] = c;
- c = fgetc(bfp);
- }
- fclose(bfp);
- fprintf(blkfs_path, "Using blkfs %s\n", ConsoleOut());
- blkfp = fopen(blkfs_path);
- if (!blkfp) {
- fprintf("Can't open\n", ConsoleOut());
- return NULL;
- }
- if (blkfp->size < 100 * 1024) {
- fclose(blkfp);
- fprintf("blkfs too small, something's wrong, aborting.\n", ConsoleOut());
- return NULL;
- }
memset(blkop, 0, #[ BLKOP_CMD_SZ c]# );
vm.SP = #[ SP_ADDR c]# ;
vm.RS = #[ RS_ADDR c]# ;
@@ -264,15 +243,9 @@ COSVM* COSVM_init(char *bin_path, char *blkfs_path)
vm.iowr[ #[ BLK_PORT c]# ] = iowr_blk;
vm.PC = 0;
vm.running = 1;
- return &vm;
-}
-
-void COSVM_deinit()
-{
- fclose(blkfp);
}
-int COSVM_steps(int n) {
+int COS_steps(int n) {
if (!vm.running) {
fprintf("machine halted!\n", ConsoleOut());
return 0;
@@ -284,7 +257,7 @@ int COSVM_steps(int n) {
return vm.running;
}
-void COSVM_printdbg() {
+void COS_printdbg() {
fprintf(
vm.SP, vm.minSP, vm.RS, vm.maxRS
"SP %w (%w) RS %w (%w)", ConsoleOut());
diff --git a/fs/app/cos/cvm.fs b/fs/app/cos/cvm.fs
@@ -1,2 +1,4 @@
?f<< /cc/lib.fs
cc<< /app/cos/cvm.c
+
+S" COSVM" findTypedef CType :export
diff --git a/fs/app/cos/dummy.bin b/fs/app/cos/dummy.bin
@@ -0,0 +1 @@
+;
+\ No newline at end of file
diff --git a/fs/app/cos/test.fs b/fs/app/cos/test.fs
@@ -0,0 +1,14 @@
+f<< /app/cos/cvm.fs
+: _err abort" CVM error" ;
+: _assert not if _err then ;
+
+COS_init
+vm structbind COSVM vm
+vm mem f" /app/cos/dummy.bin" File :readall
+vm running _assert
+\ The "dummy.bin" file is a test handcrafted binary with the equivalent of:
+\ bye
+
+\ This is not working at the moment
+1 COS_steps not _assert
+vm running not _assert
diff --git a/fs/cc/type.fs b/fs/cc/type.fs
@@ -118,6 +118,19 @@ struct[ CType
r@ name c@ if spc> r@ name stype then
r@ nbelem if '[' emit r@ nbelem . ']' emit then
r@ _( r@ nexttype ?dup if :. then r@ _) rdrop ;
+
+ : :export ( self -- )
+ dup :struct? _assert \ we can only export structs
+ dup name NEXTWORD ! struct[ llnext begin ( ctype )
+ ?dup while
+ dup name dup stype spc> NEXTWORD ! dup nbelem if ( ctype )
+ SZ &+ dup type _typesize over nbelem * dup .x nl> sallot
+ else ( ctype )
+ dup type _typesize dup .x nl> case
+ 1 of = sfieldb endof
+ 2 of = sfieldw endof
+ sfield endcase then ( ctype )
+ llnext repeat ]struct ;
]struct
\ Typedefs are dictionary entries in the "typedefs" dicts, which contain a 4b
diff --git a/testcvm.fs b/testcvm.fs
@@ -1,2 +1,2 @@
-f<< /app/cos/cvm.fs
+f<< /app/cos/test.fs
bye
